WebSVN – fastphp – Diff – /trunk/EditorMain.pas


﻿unit EditorMain;
 
{$Include 'FastPHP.inc'}
 
(*
  This program requires
  - Microsoft Internet Controls (TWebBrowser)
    If you are using Delphi 10.1 Starter Edition, please import the ActiveX TLB
    "Microsoft Internet Controls"
  - SynEdit
    You can obtain SynEdit via Embarcadero GetIt
*)
 
// TODO: "crHourGlass" does not work if F9 is pressed!
// TODO: if a scrapfile is already open, create a new scrap file (scrap2.php)
// TODO: localize
// TODO: wieso geht copy paste im twebbrowser nicht???
// TODO: Wieso dauert webbrowser1 erste kompilierung so lange???
// TODO: wieso kommt syntax fehler zweimal? einmal stderr einmal stdout?
// TODO: Browser titlebar (link preview)
// TODO: "jump to next/prev todo" buttons/shortcuts
// TODO: "increase/decrease indent" buttons/shortcuts
// TODO: Solve all compiler warnings, especially in regards Encoding
 
// Note in re Unicode:
// - In Embarcadero® Delphi 10.4 Version 27.0.40680.4203:
//   SynEdit correctly detects UTF-8 files without BOM as well as ANSI files with Umlauts.
//   (Previous versions could not detect UTF-8 files without BOM?!)
// - If BOM is existing, it will be removed. (which is good, because this is defined by PSR-1)
 
// Small things:
// - The scroll bars of SynEdit are not affected by the dark theme
// - dark theme full screen: doubleclick to desktop pixel "0,0" cannot be used to close the app
 
// Future ideas
// - code insight
// - verschiedene php versionen?
// - webbrowser1 nur laden, wenn man den tab anw�hlt?
// - doppelklick auf tab soll diesen schlie�en
// - Onlinehelp (www) aufrufen oder CHM datei
// - Let all colors be adjustable
// - code in bildschirmmitte (horizontal)?
// - search in files of a directory
// - Files in multiple tabs?
// - Configurable tabulator display-width
 
interface
 
uses
  // TODO: "{$IFDEF USE_SHDOCVW_TLB}_TLB{$ENDIF}" does not work with Delphi 10.2
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, ComCtrls, ExtCtrls, ToolWin, IniFiles,
  SynEditHighlighter, SynHighlighterPHP, SynEdit, ShDocVw, FindReplace,
  ActnList, SynEditMiscClasses, SynEditSearch, RunPHP, ImgList, SynUnicode,
  System.ImageList, System.Actions, Vcl.Menus, Vcl.Themes, System.UITypes,
  SynEditCodeFolding;
 
{.$DEFINE OnlineHelp}
 
type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    PlaintextTabSheet: TTabSheet;
    HtmlTabSheet: TTabSheet;
    Memo2: TMemo;
    WebBrowser1: TWebBrowser;
    Splitter1: TSplitter;
    PageControl2: TPageControl;
    CodeTabsheet: TTabSheet;
    HelpTabsheet: TTabSheet;
    WebBrowser2: TWebBrowser;
    OpenDialog1: TOpenDialog;
    Panel1: TPanel;
    OpenDialog3: TOpenDialog;
    SynEdit1: TSynEdit;
    SynPHPSyn1: TSynPHPSyn;
    Panel2: TPanel;
    SynEditFocusTimer: TTimer;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    ActionList: TActionList;
    ActionFind: TAction;
    ActionReplace: TAction;
    ActionFindNext: TAction;
    ActionGoto: TAction;
    ActionSave: TAction;
    ActionHelp: TAction;
    ActionRun: TAction;
    ActionESC: TAction;
    Button7: TButton;
    ActionOpen: TAction;
    Button8: TButton;
    Button9: TButton;
    ActionFindPrev: TAction;
    Timer1: TTimer;
    ActionSpaceToTab: TAction;
    Button11: TButton;
    SynEditSearch1: TSynEditSearch;
    TreeView1: TTreeView;
    Splitter2: TSplitter;
    btnLint: TButton;
    ActionLint: TAction;
    ImageList1: TImageList;
    RunPopup: TPopupMenu;
    OpeninIDE1: TMenuItem;
    ActionRunConsole: TAction;
    Runinconsole1: TMenuItem;
    SavePopup: TPopupMenu;
    Saveas1: TMenuItem;
    Save1: TMenuItem;
    SaveDialog1: TSaveDialog;
    BtnSpecialChars: TImage;
    BtnSpecialCharsOff: TImage;
    BtnSpecialCharsOn: TImage;
    BtnLightOn: TImage;
    BtnLightOff: TImage;
    BtnLight: TImage;
    StartUpTimer: TTimer;
    FileModTimer: TTimer;
    GotoPHPdir1: TMenuItem;
    PHPShell1: TMenuItem;
    ActionSaveAs: TAction;
    ActionGoToPHPDir: TAction;
    ActionPHPInteractiveShell: TAction;
    procedure Run(Sender: TObject);
    procedure RunConsole(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure PageControl2Changing(Sender: TObject; var AllowChange: Boolean);
    procedure Memo2DblClick(Sender: TObject);
    (*
    {$IFDEF USE_SHDOCVW_TLB}
    *)
    procedure WebBrowser1BeforeNavigate2(ASender: TObject;
      const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    (*
    {$ELSE}
    procedure WebBrowser1BeforeNavigate2(ASender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    {$ENDIF}
    *)
    procedure BeforeNavigate(const URL: OleVariant; var Cancel: WordBool);
    procedure SynEditFocusTimerTimer(Sender: TObject);
    procedure ActionFindExecute(Sender: TObject);
    procedure ActionReplaceExecute(Sender: TObject);
    procedure ActionFindNextExecute(Sender: TObject);
    procedure ActionGotoExecute(Sender: TObject);
    procedure ActionSaveExecute(Sender: TObject);
    procedure ActionHelpExecute(Sender: TObject);
    procedure ActionRunExecute(Sender: TObject);
    procedure ActionESCExecute(Sender: TObject);
    procedure SynEdit1MouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure SynEdit1MouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure ActionOpenExecute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Memo2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ActionFindPrevExecute(Sender: TObject);
    procedure SynEdit1MouseCursor(Sender: TObject;
      const aLineCharPos: TBufferCoord; var aCursor: TCursor);
    procedure Timer1Timer(Sender: TObject);
    procedure ActionSpaceToTabExecute(Sender: TObject);
    procedure TreeView1DblClick(Sender: TObject);
    procedure SynEdit1GutterClick(Sender: TObject; Button: TMouseButton; X, Y,
      Line: Integer; Mark: TSynEditMark);
    procedure SynEdit1PaintTransient(Sender: TObject; Canvas: TCanvas;
      TransientType: TTransientType);
    procedure ActionLintExecute(Sender: TObject);
    procedure ActionRunConsoleExecute(Sender: TObject);
    procedure SynEdit1Change(Sender: TObject);
    procedure BtnSpecialCharsClick(Sender: TObject);
    procedure WebBrowser1WindowClosing(ASender: TObject;
      IsChildWindow: WordBool; var Cancel: WordBool);
    procedure BtnLightClick(Sender: TObject);
    procedure StartUpTimerTimer(Sender: TObject);
    procedure FileModTimerTimer(Sender: TObject);
    procedure SynEdit1DropFiles(Sender: TObject; X, Y: Integer;
      AFiles: TStrings);
    procedure ActionSaveAsExecute(Sender: TObject);
    procedure ActionGoToPHPDirExecute(Sender: TObject);
    procedure ActionPHPInteractiveShellExecute(Sender: TObject);
  private
    hMutex: THandle;
    CurSearchTerm: string;
    HlpPrevPageIndex: integer;
    SrcRep: TSynEditFindReplace;
    {$IFDEF OnlineHelp}
    gOnlineHelpWord: string;
    {$ENDIF}
    FileModLast: TDateTime;
    FormShowRanOnce: boolean;
    BrowserLoadedOnce: boolean;
    procedure Help;
    function InputRequestCallback(var data: AnsiString): boolean;
    function OutputNotifyCallback(const data: AnsiString): boolean;
    procedure RightTrimAll;
  protected
    ChmIndex: TMemIniFile;
    FScrapFile: string;
    FSaveAsFilename: string;
    codeExplorer: TRunCodeExplorer;
    procedure GotoLineNo(LineNo: integer);
    function GetScrapFile: string;
    procedure StartCodeExplorer;
    procedure RefreshModifySign;
    procedure Theme_Light;
    procedure Theme_Dark;
    function IsThemeDark: boolean;
    function MarkUpLineReference(cont: string): string;
    function ContainsUnicodeCharsInAnsiFile: boolean;
    procedure SaveToFile(filename: string);
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{$R Cursors.res}
 
uses
  Functions, StrUtils, WebBrowserUtils, FastPHPUtils, Math, ShellAPI, RichEdit,
  FastPHPTreeView, ImageListEx, FastPHPConfig;
 
const
  crMouseGutter = 1;
 
procedure TForm1.RefreshModifySign;
var
  tmp: string;
begin
  tmp := Caption;
 
  tmp := StringReplace(tmp, '*', '', [rfReplaceAll]);
  if SynEdit1.Modified then tmp := tmp + '*';
 
  if Caption <> tmp then Caption := tmp;
end;
 
procedure TForm1.ActionFindNextExecute(Sender: TObject);
begin
  SrcRep.FindNext;
end;
 
procedure TForm1.ActionFindPrevExecute(Sender: TObject);
begin
  SrcRep.FindPrev;
end;
 
procedure TForm1.ActionGotoExecute(Sender: TObject);
var
  val: string;
  lineno: integer;
resourcestring
  SGoTo = 'Go to';
  SLineNumber = 'Line number:';
begin
  // TODO: VK_LMENU does not work! only works with AltGr but not Alt
  // http://stackoverflow.com/questions/16828250/delphi-xe2-how-to-prevent-the-alt-key-stealing-focus ?
 
  if not InputQuery(SGoTo, SLineNumber, val) or
     not TryStrToInt(val, lineno) then
  begin
    if SynEdit1.CanFocus then SynEdit1.SetFocus;
    exit;
  end;
  GotoLineNo(lineno);
end;
 
procedure TForm1.ActionGoToPHPDirExecute(Sender: TObject);
var
  phpExe: string;
begin
  phpExe := GetPHPExe;
  if phpExe <> '' then
    ShellExecute(Handle, 'open', 'explorer.exe', PChar(ExtractFilePath(phpExe)), '', SW_NORMAL);
end;
 
procedure TForm1.ActionHelpExecute(Sender: TObject);
begin
  Help;
  if PageControl2.ActivePage = HelpTabsheet then
    WebBrowser2.SetFocus
  else if PageControl2.ActivePage = CodeTabsheet then
    SynEdit1.SetFocus;
end;
 
procedure TForm1.ActionLintExecute(Sender: TObject);
begin
  Run(Sender);
  SynEdit1.SetFocus;
end;
 
procedure TForm1.ActionOpenExecute(Sender: TObject);
begin
  If OpenDialog3.Execute then
  begin
    ShellExecute(0, 'open', PChar(ParamStr(0)), PChar('"' + OpenDialog3.FileName + '"'), '', SW_NORMAL);
  end;
end;
 
procedure TForm1.ActionPHPInteractiveShellExecute(Sender: TObject);
var
  phpExe: string;
begin
  phpExe := GetPHPExe;
  if phpExe <> '' then
    ShellExecute(Handle, 'open', PChar(phpExe), '-a', PChar(ExtractFilePath(phpExe)), SW_NORMAL);
end;
 
procedure TForm1.ActionReplaceExecute(Sender: TObject);
begin
  SrcRep.ReplaceExecute;
end;
 
procedure TForm1.ActionRunConsoleExecute(Sender: TObject);
begin
  RunConsole(Sender);
  SynEdit1.SetFocus;
end;
 
procedure TForm1.ActionRunExecute(Sender: TObject);
begin
  Run(Sender);
  SynEdit1.SetFocus;
end;
 
procedure TForm1.RightTrimAll;
var
  i: integer;
begin
  for i := 0 to SynEdit1.Lines.Count-1 do
  begin
    SynEdit1.Lines.Strings[i] := TrimRight(SynEdit1.Lines.Strings[i]);
  end;
 
  (*
  while (SynEdit1.Lines.Count > 0) and (SynEdit1.Lines.Strings[SynEdit1.Lines.Count-1] = '') do
  begin
    SynEdit1.Lines.Delete(SynEdit1.Lines.Count-1);
  end;
  if SynEdit1.SelStart > Length(SynEdit1.Text)-1 then
  begin
    // TODO: This code does not work...
    SynEdit1.SelStart := Length(SynEdit1.Text)-1;
    SynEdit1.SelEnd   := Length(SynEdit1.Text)-1;
  end;
  *)
end;
 
procedure TForm1.ActionSaveAsExecute(Sender: TObject);
var
  hMutexNew: THandle;
resourcestring
  SCannotSaveBecauseMutex = 'Cannot save because file "%s", because it is alrady open in another FastPHP window!';
begin
  if SaveDialog1.Execute then
  begin
    {$REGION 'Switch mutex'}
    hMutexNew := CreateMutex(nil, True, PChar('FastPHP'+md5(UpperCase(SaveDialog1.FileName))));
    if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      ShowMessageFmt(SCannotSaveBecauseMutex, [SaveDialog1.FileName]);
      Close;
    end;
 
    if hMutex <> 0 then CloseHandle(hMutex); // Note: ReleaseMutex does not work as expected!
    hMutex := hMutexNew;
    {$ENDREGION}
 
    FSaveAsFilename := SaveDialog1.FileName;
    Caption := Copy(Caption, 1, Pos(' - ', Caption)-1) + ' - ' + FSaveAsFilename;
    Application.Title := Format('%s - FastPHP', [ExtractFileName(FSaveAsFilename)]); // do not translate!
    Button7.Click;
  end;
end;
 
procedure TForm1.ActionSaveExecute(Sender: TObject);
begin
  RightTrimAll;
  SaveToFile(GetScrapFile);
  SynEdit1.Modified := false;
  RefreshModifySign;
  if SynEdit1.CanFocus then SynEdit1.SetFocus;
end;
 
procedure TForm1.ActionSpaceToTabExecute(Sender: TObject);
 
    function SpacesAtBeginning(line: string): integer;
    begin
      result := 0;
      if Trim(line) = '' then exit;
      while line[result+1] = ' ' do
      begin
        inc(result);
      end;
    end;
 
    function GuessIndent(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}): integer;
      function _Check(indent: integer): boolean;
      var
        i: integer;
      begin
        result := true;
        for i := 0 to lines.Count-1 do
          if SpacesAtBeginning(lines.Strings[i]) mod indent <> 0 then
          begin
            // ShowMessageFmt('Zeile "%s" nicht durch %d teilbar!', [lines.strings[i], indent]);
            result := false;
            exit;
          end;
      end;
    var
      i: integer;
    begin
      for i := 8 downto 2 do
      begin
        if _Check(i) then
        begin
          result := i;
          exit;
        end;
      end;
      result := -1;
    end;
 
    procedure SpaceToTab(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}; indent: integer);
    var
      i, spaces: integer;
      newval: string;
      somethingchanged: boolean;
    begin
      somethingchanged := false;
      for i := 0 to lines.Count-1 do
      begin
        spaces := SpacesAtBeginning(lines.Strings[i]);
        newval := StringOfChar(#9, spaces div indent) + StringOfChar(' ', spaces mod indent) + Copy(lines.Strings[i], spaces+1, Length(lines.Strings[i])-spaces);
        if lines.Strings[i] <> newval then
        begin
          somethingchanged := true;
          lines.Strings[i] := newval;
        end;
      end;
      if somethingchanged then
      begin
        SynEdit1Change(SynEdit1); // set the "changed" flag
      end;
    end;
 
    function SpacesAvailable(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}): boolean;
    var
      i, spaces: integer;
    begin
      for i := 0 to lines.Count-1 do
      begin
        spaces := SpacesAtBeginning(lines.Strings[i]);
        if spaces > 0 then
        begin
          result := true;
          exit;
        end;
      end;
      result := false;
      exit;
    end;
 
var
  val: string;
  ind: integer;
resourcestring
  SNoLinesAvailable = 'No lines with spaces at the beginning available';
  SSpacesToLabs = 'Spaces to tabs';
  SIndent = 'Indent:';
begin
  // TODO: if something is selected, only process the selected part
 
  if not SpacesAvailable(SynEdit1.Lines) then
  begin
    MessageDlg(SNoLinesAvailable, mtInformation, [mbOk], 0);
    exit;
  end;
 
  ind := GuessIndent(SynEdit1.Lines);
  if ind <> -1 then val := IntToStr(ind);
 
  if not InputQuery(SSpacesToLabs, SIndent, val) or
     not TryStrToInt(Trim(val), ind) then
  begin
    if SynEdit1.CanFocus then SynEdit1.SetFocus;
    exit;
  end;
 
  if ind = 0 then exit;
  SpaceToTab(SynEdit1.Lines, ind);
end;
 
procedure TForm1.ActionESCExecute(Sender: TObject);
begin
  if (HlpPrevPageIndex <> -1) and (PageControl2.ActivePage = HelpTabSheet) and
     (HelpTabsheet.TabVisible) then
  begin
    PageControl2.ActivePageIndex := HlpPrevPageIndex;
    HelpTabsheet.TabVisible := false;
  end;
 
  // Dirty hack...
  SrcRep.CloseDialogs;
end;
 
procedure TForm1.ActionFindExecute(Sender: TObject);
begin
  SrcRep.FindExecute;
end;
 
procedure TForm1.Run(Sender: TObject);
var
  bakTS: TTabSheet;
  //ss: TStringStream;
  //bakPos: Int64;
begin
  memo2.Lines.Text := '';
 
  if not BrowserLoadedOnce then
  begin
    bakTS := PageControl1.ActivePage;
    try
      PageControl1.ActivePage := HtmlTabSheet; // Required for the first time, otherwise, WebBrowser1.Clear will hang
      Webbrowser1.Clear;
    finally
      PageControl1.ActivePage := bakTS;
    end;
    BrowserLoadedOnce := true;
  end
  else
    Webbrowser1.Clear;
 
  Screen.Cursor := crHourGlass; // TODO: Doesn't work with F9
  Application.ProcessMessages;
 
  try
    ActionSave.Execute; // TODO: if it is not the scrap file: do not save the file, since the user did not intended to save... better create a temporary file and run it instead.
 
    // TODO 70421 * <fastphp> implement flush() with ContentCallBack implementieren... For long running scripts I want to see status changes via javascript which are loaded step by step
    // TODO 70422 * <fastphp> when a script has an endless loop, i want to have a possibility to cancel it
    if SynEdit1.Lines.Encoding = TEncoding.UTF8 then
      memo2.Lines.Text := Utf8Decode(RunPHPScript(GetScrapFile, Sender=ActionLint, False)) // if we have a UTF-8 file, then the DOS output is double-UTF8 encoded
    else
      memo2.Lines.Text := RunPHPScript(GetScrapFile, Sender=ActionLint, False);
 
    {$REGION 'Show in Web Browser'}
    if SynEdit1.Lines.Encoding = TEncoding.UTF8 then
      Webbrowser1.LoadHTML(MarkUpLineReference('<meta charset="utf-8">'+memo2.Lines.Text), GetScrapFile)
    else
      Webbrowser1.LoadHTML(MarkUpLineReference(memo2.Lines.Text), GetScrapFile);
 
    // Alternatively:
    (*
    ss := TstringStream.Create;
    ss.WriteString(MarkUpLineReference(memo2.Lines.Text));
    ss.Position := 0;
    Webbrowser1.LoadStream(ss, GetScrapFile);
    Webbrowser1.Wait;
    ss.Free;
    *)
    {$ENDREGION}
 
    if IsTextHTML(memo2.lines.text) then
      PageControl1.ActivePage := HtmlTabSheet
    else
      PageControl1.ActivePage := PlaintextTabSheet;
  finally
    Screen.Cursor := crDefault;
  end;
end;
 
procedure TForm1.RunConsole(Sender: TObject);
begin
  ActionSave.Execute; // TODO: if it is not the scrap file: do not save the file, since the user did not intended to save... better create a temporary file and run it instead.
  RunPHPScript(GetScrapFile, Sender=ActionLint, True);
end;
 
procedure TForm1.SynEdit1Change(Sender: TObject);
begin
  RefreshModifySign;
end;
 
procedure TForm1.SynEdit1DropFiles(Sender: TObject; X, Y: Integer;
  AFiles: TStrings);
var
  FileName: string;
const
  WARN_FILE_COUNT = 10;
resourcestring
  SAreYouSure = 'Are you sure you want to open %d files?';
begin
  if AFiles.Count > WARN_FILE_COUNT then
  begin
    if not MessageDlg(Format(SAreYouSure, [WARN_FILE_COUNT]), mtConfirmation, mbYesNoCancel, 0) <> mrYes then
      exit;
  end;
 
  for FileName in AFiles do
  begin
    ShellExecute(0, 'open', PChar(ParamStr(0)), PChar('"' + FileName + '"'), '', SW_NORMAL);
  end;
end;
 
procedure TForm1.SynEdit1GutterClick(Sender: TObject; Button: TMouseButton; X,
  Y, Line: Integer; Mark: TSynEditMark);
begin
  (*
  TSynEdit(Sender).CaretX := 1;
  TSynEdit(Sender).CaretY := Line;
  TSynEdit(Sender).SelLength := Length(TSynEdit(Sender).LineText);
  *)
end;
 
procedure TForm1.SynEdit1MouseCursor(Sender: TObject; const aLineCharPos: TBufferCoord; var aCursor: TCursor);
{$IFDEF OnlineHelp}
var
  Line: Integer;
  Column: Integer;
  word: string;
begin
  Line  := aLineCharPos.Line-1;
  Column := aLineCharPos.Char-1;
  word := GetWordUnderPos(TSynEdit(Sender), Line, Column);
  if word <> gOnlineHelpWord then
  begin
    gOnlineHelpWord := word;
    Timer1.Enabled := false;
    Timer1.Enabled := true;
  end;
{$ELSE}
begin
{$ENDIF}
end;
 
procedure TForm1.SynEdit1MouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  if ssCtrl in Shift then
  begin
    SynEdit1.Font.Size := Max(SynEdit1.Font.Size - 1, 5);
    Handled := true;
  end
  else Handled := false;
end;
 
procedure TForm1.SynEdit1MouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  if ssCtrl in Shift then
  begin
    SynEdit1.Font.Size := SynEdit1.Font.Size + 1;
    Handled := true;
  end
  else Handled := false;
end;
 
procedure TForm1.SynEdit1PaintTransient(Sender: TObject; Canvas: TCanvas; TransientType: TTransientType);
var
  Editor: TSynEdit;
  OpenChars: array of WideChar;//[0..2] of WideChar=();
  CloseChars: array of WideChar;//[0..2] of WideChar=();
 
  function IsCharBracket(AChar: WideChar): Boolean;
  begin
    case AChar of
      '{','[','(','<','}',']',')','>':
        Result := True;
      else
        Result := False;
    end;
  end;
 
  function CharToPixels(P: TBufferCoord): TPoint;
  begin
    Result := Editor.RowColumnToPixels(Editor.BufferToDisplayPos(P));
  end;
 
var
  COLOR_FG: TColor;
  COLOR_BG: TColor;
  P: TBufferCoord;
  Pix: TPoint;
  D: TDisplayCoord;
  S: UnicodeString;
  I: Integer;
  Attri: TSynHighlighterAttributes;
  ArrayLength: Integer;
  start: Integer;
  TmpCharA, TmpCharB: WideChar;
begin
  // Source: https://github.com/SynEdit/SynEdit/blob/master/Demos/OnPaintTransientDemo/Unit1.pas
 
  if IsThemeDark then
  begin
    COLOR_FG := clLime;
    COLOR_BG := clGreen;
  end
  else
  begin
    COLOR_FG := clGreen;
    COLOR_BG := clLime;
  end;
 
  if TSynEdit(Sender).SelAvail then exit;
  Editor := TSynEdit(Sender);
  ArrayLength:= 3;
 
  (*
  if (Editor.Highlighter = shHTML) or (Editor.Highlighter = shXML) then
    inc(ArrayLength);
  *)
 
  SetLength(OpenChars, ArrayLength);
  SetLength(CloseChars, ArrayLength);
  for i := 0 to ArrayLength - 1 do
  begin
    case i of
      0: begin OpenChars[i] := '('; CloseChars[i] := ')'; end;
      1: begin OpenChars[i] := '{'; CloseChars[i] := '}'; end;
      2: begin OpenChars[i] := '['; CloseChars[i] := ']'; end;
      3: begin OpenChars[i] := '<'; CloseChars[i] := '>'; end;
    end;
  end;
 
  P := Editor.CaretXY;
  D := Editor.DisplayXY;
 
  Start := Editor.SelStart;
 
  if (Start > 0) and (Start <= length(Editor.Text)) then
    TmpCharA := Editor.Text[Start]
  else
    TmpCharA := #0;
 
  if (Start > 0){Added by VTS} and (Start < length(Editor.Text)) then
    TmpCharB := Editor.Text[Start + 1]
  else
    TmpCharB := #0;
 
  if not IsCharBracket(TmpCharA) and not IsCharBracket(TmpCharB) then exit;
  S := TmpCharB;
  if not IsCharBracket(TmpCharB) then
  begin
    P.Char := P.Char - 1;
    S := TmpCharA;
  end;
  Editor.GetHighlighterAttriAtRowCol(P, S, Attri);
 
  if (Editor.Highlighter.SymbolAttribute = Attri) then
  begin
    for i := low(OpenChars) to High(OpenChars) do
    begin
      if (S = OpenChars[i]) or (S = CloseChars[i]) then
      begin
        Pix := CharToPixels(P);
 
        Editor.Canvas.Brush.Style := bsSolid;//Clear;
        Editor.Canvas.Font.Assign(Editor.Font);
        Editor.Canvas.Font.Style := Attri.Style;
 
        if (TransientType = ttAfter) then
        begin
          Editor.Canvas.Font.Color := COLOR_FG;
          Editor.Canvas.Brush.Color := COLOR_BG;
        end
        else
        begin
          Editor.Canvas.Font.Color := Attri.Foreground;
          Editor.Canvas.Brush.Color := Attri.Background;
        end;
        if Editor.Canvas.Font.Color = clNone then
          Editor.Canvas.Font.Color := Editor.Font.Color;
        if Editor.Canvas.Brush.Color = clNone then
          Editor.Canvas.Brush.Color := Editor.Color;
 
        Editor.Canvas.TextOut(Pix.X, Pix.Y, S);
        P := Editor.GetMatchingBracketEx(P);
 
        if (P.Char > 0) and (P.Line > 0) then
        begin
          Pix := CharToPixels(P);
          if Pix.X > Editor.Gutter.Width then
          begin
            {$REGION 'Added by ViaThinkSoft'}
            if (TransientType = ttAfter) then
            begin
              Editor.Canvas.Font.Color := COLOR_FG;
              Editor.Canvas.Brush.Color := COLOR_BG;
            end
            else
            begin
              Editor.Canvas.Font.Color := Attri.Foreground;
              Editor.Canvas.Brush.Color := Attri.Background;
            end;
            if Editor.Canvas.Font.Color = clNone then
              Editor.Canvas.Font.Color := Editor.Font.Color;
            if Editor.Canvas.Brush.Color = clNone then
              Editor.Canvas.Brush.Color := Editor.Color;
            {$ENDREGION}
            if S = OpenChars[i] then
              Editor.Canvas.TextOut(Pix.X, Pix.Y, CloseChars[i])
            else Editor.Canvas.TextOut(Pix.X, Pix.Y, OpenChars[i]);
          end;
        end;
      end;
    end;
    Editor.Canvas.Brush.Style := bsSolid;
  end;
end;
 
procedure TForm1.SynEditFocusTimerTimer(Sender: TObject);
begin
  SynEditFocusTimer.Enabled := false;
  Button1.SetFocus; // Workaround for weird bug... This (and the timer) is necessary to get the focus to SynEdit1
  SynEdit1.SetFocus;
end;
 
procedure TForm1.Theme_Dark;
begin
  if IsThemeDark then exit;
  TStyleManager.TrySetStyle('Windows10 SlateGray'); // do not translate
  Color := 1316887;
  Font.Color := clCream;
  //Memo2.Font.Color := clCream;
  //Memo2.ParentColor := true;
  SynEdit1.ActiveLineColor := 2238502;
  SynEdit1.Color := 1316887;
  SynEdit1.Font.Color := clCream;
  SynEdit1.Gutter.Color := 1316887;
  SynEdit1.Gutter.Font.Color := clCream;
  SynEdit1.Gutter.GradientStartColor := 2238502;
  SynEdit1.Gutter.GradientEndColor := 1316887;
  SynPHPSyn1.CommentAttri.Foreground := $00837B82;
  SynPHPSyn1.IdentifierAttri.Foreground := 9627120;
  SynPHPSyn1.KeyAttri.Foreground := 4157595;
  SynPHPSyn1.NumberAttri.Foreground := 5008079;
  SynPHPSyn1.StringAttri.Foreground := 6987151;
  SynPHPSyn1.SymbolAttri.Foreground := 8769754;
  SynPHPSyn1.VariableAttri.Foreground := 6924493;
end;
 
procedure TForm1.Theme_Light;
begin
  if not IsThemeDark then exit;
  TStyleManager.TrySetStyle('Windows'); // do not translate
  Color := clBtnFace;
  Font.Color := clWindowText;
  //Memo2.Font.Color := clWindowText;
  SynEdit1.ActiveLineColor := 14680010;
  SynEdit1.Color := clCream;
  SynEdit1.Font.Color := clWindowText;
  SynEdit1.Gutter.Color := clBtnFace;
  SynEdit1.Gutter.Font.Color := clWindowText;
  SynEdit1.Gutter.GradientStartcolor := cl3dLight;
  SynEdit1.Gutter.GradientEndColor := clBtnFace;;
  SynPHPSyn1.CommentAttri.Foreground := 33023;
  SynPHPSyn1.IdentifierAttri.Foreground := 4194304;
  SynPHPSyn1.KeyAttri.Foreground := 4227072;
  SynPHPSyn1.NumberAttri.Foreground := 213;
  SynPHPSyn1.StringAttri.Foreground := 13762560;
  SynPHPSyn1.SymbolAttri.Foreground := 4227072;
  SynPHPSyn1.VariableAttri.Foreground := 213;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  {$IFDEF OnlineHelp}
  Timer1.Enabled := false;
 
  // TODO: Insert a small online help hint
  //Caption := gOnlineHelpWord;
  {$ENDIF}
end;
 
procedure TForm1.TreeView1DblClick(Sender: TObject);
var
  tn: TTreeNode;
  lineNo: integer;
begin
  tn := TTreeView(Sender).Selected;
  if tn = nil then exit;
  lineNo := Integer(tn.Data);
  if lineNo > 0 then GotoLineNo(lineNo);
end;
 
(*
{$IFDEF USE_SHDOCVW_TLB}
*)
procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject;
  const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  BeforeNavigate(URL, Cancel);
end;
(*
{$ELSE}
procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  BeforeNavigate(URL, Cancel);
end;
{$ENDIF}
*)
 
procedure TForm1.WebBrowser1WindowClosing(ASender: TObject;
  IsChildWindow: WordBool; var Cancel: WordBool);
resourcestring
  SCloseRequest = 'A script has requested the window to be closed. The window of a standalone script would now close.';
begin
  ShowMessage(SCloseRequest);
  TWebBrowser(ASender).Clear;
  Cancel := true;
end;
 
procedure TForm1.BeforeNavigate(const URL: OleVariant; var Cancel: WordBool);
var
  s, myURL: string;
  lineno: integer;
  p: integer;
begin
  {$REGION 'Line number references (PHP errors and warnings)'}
  if Copy(URL, 1, length(FASTPHP_GOTO_URI_PREFIX)) = FASTPHP_GOTO_URI_PREFIX then
  begin
    try
      s := copy(URL, length(FASTPHP_GOTO_URI_PREFIX)+1, 99);
      if not TryStrToInt(s, lineno) then exit;
      GotoLineNo(lineno);
      SynEditFocusTimer.Enabled := true;
    finally
      Cancel := true;
    end;
    Exit;
  end;
  {$ENDREGION}
 
  {$REGION 'Intelligent browser (executes PHP scripts which are clicked in a hyperlink)'}
  if URL <> 'about:blank' then
  begin
    myUrl := URL;
 
    p := Pos('?', myUrl);
    if p >= 1 then myURL := copy(myURL, 1, p-1);
 
    // TODO: myURL urldecode
    // TODO: maybe we could even open that file in the editor!
    // TODO: ?parameter=....
 
    if FileExists(myURL) and (EndsText('.php', myURL) or EndsText('.php3', myURL) or EndsText('.php4', myURL) or EndsText('.php5', myURL) or EndsText('.phps', myURL)) then
    begin
      WebBrowser1.LoadHTML(RunPHPScript(myURL), myUrl);
      Cancel := true;
    end;
  end;
  {$ENDREGION}
end;
 
procedure TForm1.BtnLightClick(Sender: TObject);
var
  CanClose: boolean;
begin
  FormCloseQuery(Form1, CanClose);
  if not CanClose then exit;
 
  if IsThemeDark then
  begin
    BtnLight.Picture.Assign(BtnLightOn.Picture);
    Theme_Light;
    TFastPHPConfig.DarkTheme := false;
  end
  else
  begin
    BtnLight.Picture.Assign(BtnLightOff.Picture);
    Theme_Dark;
    TFastPHPConfig.DarkTheme := true;
  end;
end;
 
procedure TForm1.BtnSpecialCharsClick(Sender: TObject);
var
  opts: TSynEditorOptions;
begin
  opts := SynEdit1.Options;
  if eoShowSpecialChars in SynEdit1.Options then
  begin
    BtnSpecialChars.Picture.Assign(BtnSpecialCharsOff.Picture);
    Exclude(opts, eoShowSpecialChars);
    TFastPHPConfig.SpecialChars := false;
  end
  else
  begin
    BtnSpecialChars.Picture.Assign(BtnSpecialCharsOn.Picture);
    Include(opts, eoShowSpecialChars);
    TFastPHPConfig.SpecialChars := true;
  end;
  SynEdit1.Options := opts;
end;
 
procedure TForm1.FileModTimerTimer(Sender: TObject);
resourcestring
  SChangeConflict = 'The file was changed in a different application BUT IT WAS ALSO MODIFIED HERE! Reload file AND LOSE CHANGES HERE?';
  SChangeNotify = 'The file was changed in a different application! Reload file?';
begin
  FileModTimer.Enabled := false;
  if FileModLast <> FileAge(GetScrapFile) then
  begin
    FileModLast := FileAge(GetScrapFile);
    if SynEdit1.Modified then
    begin
      if MessageDlg(SChangeConflict, mtWarning, mbYesNoCancel, 0) = mrYes then
      begin
        SynEdit1.Lines.LoadFromFile(GetScrapFile);
      end;
    end
    else
    begin
      if MessageDlg(SChangeNotify, mtConfirmation, mbYesNoCancel, 0) = mrYes then
      begin
        SynEdit1.Lines.LoadFromFile(GetScrapFile);
      end;
    end;
  end;
  FileModTimer.Enabled := true;
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  DragAcceptFiles(Handle, False);
  TFastPHPConfig.FontSize := SynEdit1.Font.Size;
end;
 
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  r: integer;
resourcestring
  SWantToSave = 'Do you want to save?';
begin
  if SynEdit1.Modified then
  begin
    if (ParamStr(1) <> '') or (FSaveAsFilename <> '') then
    begin
      r := MessageDlg(SWantToSave, mtConfirmation, mbYesNoCancel, 0);
      if r = mrCancel then
      begin
        CanClose := false;
        Exit;
      end
      else if r = mrYes then
      begin
        ActionSave.Execute;
        CanClose := true;
      end;
    end
    else
    begin
      ActionSave.Execute;
      CanClose := true;
    end;
  end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  exeDir: string;
  sScrapFile: string;
begin
  HlpPrevPageIndex := -1;
  CurSearchTerm := '';
  sScrapFile := GetScrapFile;
  Caption := Caption + ' - ' + sScrapFile;
  Application.Title := Format('%s - FastPHP', [ExtractFileName(sScrapFile)]); // do not translate!
  SrcRep := TSynEditFindReplace.Create(self);
  SrcRep.Editor := SynEdit1;
  SynEdit1.Gutter.Gradient := HighColorWindows;
 
  Screen.Cursors[crMouseGutter] := LoadCursor(hInstance, 'MOUSEGUTTER');
  SynEdit1.Gutter.Cursor := crMouseGutter;
 
  exeDir := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
  if FileExists(exeDir + 'codeexplorer.bmp') then ImageList1.LoadAndSplitImages(exeDir + 'codeexplorer.bmp');
 
  FileModLast := FileAge(sScrapFile);
  FileModTimer.Enabled := True;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(ChmIndex) then
  begin
    FreeAndNil(ChmIndex);
  end;
  FreeAndNil(SrcRep);
 
  if hMutex <> 0 then CloseHandle(hMutex); // Note: ReleaseMutex does not work as expected!
 
  if Assigned(codeExplorer) then
  begin
    codeExplorer.Terminate;
    codeExplorer.WaitFor;
    FreeAndNil(codeExplorer);
  end;
end;
 
procedure TForm1.FormShow(Sender: TObject);
var
  ScrapFile: string;
  tmpFontSize: integer;
  opts: TSynEditorOptions;
resourcestring
  SFileAlreadyOpen = 'File "%s" is alrady open!';
begin
  if FormShowRanOnce then exit; // If the theme is changed from normal to dark, OnShow will be called another time
  FormShowRanOnce := true;
 
  ScrapFile := GetScrapFile;
  if ScrapFile = '' then
  begin
    Application.Terminate; // Close;
    exit;
  end;
 
  opts := SynEdit1.Options;
  if TFastPHPConfig.SpecialChars then
  begin
    BtnSpecialChars.Picture.Assign(BtnSpecialCharsOn.Picture);
    Include(opts, eoShowSpecialChars);
  end
  else
  begin
    BtnSpecialChars.Picture.Assign(BtnSpecialCharsOff.Picture);
    Exclude(opts, eoShowSpecialChars);
  end;
  SynEdit1.Options := opts;
 
  if FileExists(ScrapFile) then
  begin
    if hMutex = 0 then
    begin
      hMutex := CreateMutex(nil, True, PChar('FastPHP'+md5(UpperCase(ScrapFile))));
      if GetLastError = ERROR_ALREADY_EXISTS then
      begin
        // TODO: It would be great if the window of that FastPHP instance would switched to foreground
        ShowMessageFmt(SFileAlreadyOpen, [ScrapFile]);
        Close;
      end;
 
      SynEdit1.Lines.LoadFromFile(ScrapFile);
    end;
  end
  else
    SynEdit1.Lines.Clear;
 
  PageControl1.ActivePage := PlaintextTabSheet;
 
  PageControl2.ActivePage := CodeTabsheet;
  HelpTabsheet.TabVisible := false;
 
  tmpFontSize := TFastPHPConfig.FontSize;
  if tmpFontSize <> -1 then SynEdit1.Font.Size := tmpFontSize;
  SynEdit1.SetFocus;
 
  DoubleBuffered := true;
  StartCodeExplorer;
 
  DragAcceptFiles(Handle, True);
 
  StartupTimer.Enabled := true;
end;
 
function TForm1.ContainsUnicodeCharsInAnsiFile: boolean;
var
  lines: TStringList;
  ms: TMemoryStream;
begin
  if SynEdit1.Lines.Encoding = TEncoding.UTF8 then
  begin
    result := false;
    exit;
  end;
 
  lines := TStringList.Create;
  ms := TMemoryStream.Create;
  try
    SynEdit1.Lines.SaveToStream(ms);
    ms.Position := 0;
    lines.LoadFromStream(ms);
    result := Trim(lines.Text) <> Trim(synedit1.Lines.Text);
  finally
    FreeAndNil(ms);
    FreeAndNil(lines);
  end;
end;
 
procedure TForm1.SaveToFile(filename: string);
var
  ss: TStringStream;
  ms: TMemoryStream;
  fs: TFileStream;
  eolStyle: string;
  str: string;
  UpgradeEncodingToUnicode: boolean;
  DoReloadEncoding: boolean;
resourcestring
  LNG_UpgradeToUtf8 = 'Unicode characters have been inserted to this ANSI encoded file. Convert file to UTF-8? (If you choose "No", the Unicode characters will be replaced with "?")';
begin
  FileModTimer.Enabled := false;
 
  if ContainsUnicodeCharsInAnsiFile then
  begin
    DoReloadEncoding := true;
    case MessageBox(Handle, PChar(LNG_UpgradeToUtf8), PChar(Caption), MB_YESNOCANCEL) of
      ID_YES:
      begin
        UpgradeEncodingToUnicode := true;
      end;
      ID_NO:
      begin
        UpgradeEncodingToUnicode := false;
      end;
      ID_CANCEL:
      begin
        Abort;
      end;
    end;
  end
  else
  begin
    DoReloadEncoding := false;
    UpgradeEncodingToUnicode := false;
  end;
 
  ms := TMemoryStream.Create;
  ss := TStringStream.Create('');
  fs := TFileStream.Create(filename, fmCreate);
  try
    // Save everything in a memory stream and then to a string
    // in comparison to "str := SynEdit1.Lines.Text;",
    // This approach should preserve LF / CRLF line endings
    if UpgradeEncodingToUnicode then
      SynEdit1.Lines.SaveToStream(ms, TEncoding.UTF8) // upgrade an ANSI file to UTF-8 (e.g. if you include Japanese characters)
    else
      SynEdit1.Lines.SaveToStream(ms);
    if DoReloadEncoding then
    begin
      ms.Position := 0;
      SynEdit1.Lines.LoadFromStream(ms);
    end;
    ms.Position := 0;
    ss.CopyFrom(ms, ms.Size);
    ss.Position := 0;
    str := ss.ReadString(ss.Size);
    ss.Size := 0; // clear string-stream, because we need it later again
 
    // Detect current line-endings
    if Copy(str, 1, 2) = '#!' then
    begin
      // Shebang. Use ONLY Linux LF
      str := StringReplace(str, #13#10, #10, [rfReplaceAll]);
      eolStyle := #10 // Linux LF
    end
    else
    begin
      if Pos(#13#10, str) > 0 then
        eolStyle := #13#10 // Windows CRLF
      else if Pos(#10, str) > 0 then
        eolStyle := #10 // Linux LF
      else
      begin
        if DefaultTextLineBreakStyle = tlbsLF then
          eolStyle := #10 // Linux LF
        else if DefaultTextLineBreakStyle = tlbsCRLF then
          eolStyle := #13#10 // Windows CRLF
        //else if DefaultTextLineBreakStyle = tlbsCR then
        //  eolStyle := #13 // Old Mac CR
        else
          eolStyle := #13#10; // (Should not happen)
      end;
    end;
 
    // Unitfy line-endings
 
 
    str := StringReplace(str, #13, '', [rfReplaceAll]);
    str := StringReplace(str, #10, eolStyle, [rfReplaceAll]);
 
    // Replace all trailing linebreaks by a single line break
    // Note: Removing all line breaks is not good, since Linux's "nano" will
    //       re-add a linebreak at the end of the file
    str := TrimRight(str) + eolStyle;
 
    // Old versions of Delphi/SynEdit write an UTF-8 BOM, which makes problems
    // e.g. with AJAX handlers (because AJAX reponses must not have a BOM).
    // So we try to avoid that.
    // Note that the output is still UTF-8 encoded if the input file was UTF-8 encoded
    if Copy(str,1,3) = #$EF#$BB#$BF then Delete(str, 1, 3);
 
    // Now save to the file
    ss.WriteString(str);
    ss.Position := 0;
    fs.CopyFrom(ss, ss.Size-ss.Position);
  finally
    FreeAndNil(ms);
    FreeAndNil(ss);
    FreeAndNil(fs);
  end;
 
  FileModLast := FileAge(GetScrapFile);
  FileModTimer.Enabled := True;
end;
 
procedure TForm1.StartCodeExplorer;
begin
  codeExplorer := TRunCodeExplorer.Create(true);
  codeExplorer.InputRequestCallback := InputRequestCallback;
  codeExplorer.OutputNotifyCallback := OutputNotifyCallback;
  codeExplorer.PhpExe := GetPHPExe;
  codeExplorer.PhpFile := IncludeTrailingPathDelimiter(ExtractFileDir(Application.ExeName)) + 'codeexplorer.php'; // GetScrapFile;
  codeExplorer.WorkDir := ExtractFileDir(Application.ExeName);
  codeExplorer.Resume;
end;
 
procedure TForm1.StartUpTimerTimer(Sender: TObject);
begin
  StartupTimer.Enabled := false;
 
  // We need this timer because we cannot change the Theme during OnShow,
  // because the Delphi VCL Theme is buggy!
 
  if TFastPHPConfig.DarkTheme then
  begin
    BtnLight.Picture.Assign(BtnLightOff.Picture);
    Theme_Dark;
  end
  else
  begin
    BtnLight.Picture.Assign(BtnLightOn.Picture);
    Theme_Light;
  end;
end;
 
function TForm1.GetScrapFile: string;
var
  tmpPath: string;
resourcestring
  SFileDoesNotExistsCreate = 'File %s does not exist. Create it?';
  SPathDoesNotExistTryAgain = 'Path does not exist! Please try again.';
begin
  if FSaveAsFilename <> '' then
  begin
    result := FSaveAsFilename;
    exit;
  end;
 
  if FScrapFile <> '' then
  begin
    result := FScrapFile;
    exit;
  end;
 
  if ParamStr(1) <> '' then
  begin
    // Program was started with a filename
 
    result := ParamStr(1);
 
    if not FileExists(result) then
    begin
      case MessageDlg(Format(SFileDoesNotExistsCreate, [result]), mtConfirmation, mbYesNoCancel, 0) of
        mrYes:
          try
            SaveToFile(result);
          except
            on E: Exception do
            begin
              MessageDlg(E.Message, mtError, [mbOk], 0);
              Application.Terminate;
              result := '';
              exit;
            end;
          end;
        mrNo:
          begin
            Application.Terminate;
            result := '';
            exit;
          end;
        mrCancel:
          begin
            Application.Terminate;
            result := '';
            exit;
          end;
      end;
    end;
  end
  else
  begin
    // Program is started without filename -> use scrap file
 
    result := TFastPHPConfig.ScrapFile;
 
    if not FileExists(result) then
    begin
      repeat
        {$REGION 'Determinate opendialog initial directory'}
        if result <> '' then
        begin
          tmpPath := ExtractFilePath(result);
          if DirectoryExists(tmpPath) then
          begin
            OpenDialog3.InitialDir := tmpPath;
            OpenDialog3.FileName := Result;
          end
          else
          begin
            OpenDialog3.InitialDir := GetMyDocumentsFolder;
          end;
        end
        else
        begin
          OpenDialog3.InitialDir := GetMyDocumentsFolder;
        end;
        {$ENDREGION}
 
        if not OpenDialog3.Execute then
        begin
          Application.Terminate;
          result := '';
          exit;
        end;
 
        if not DirectoryExists(ExtractFilePath(OpenDialog3.FileName)) then
        begin
          MessageDlg(SPathDoesNotExistTryAgain, mtWarning, [mbOk], 0);
        end
        else
        begin
          result := OpenDialog3.FileName;
        end;
      until result <> '';
 
      if not FileExists(result) then
      begin
        try
          // Try saving the file; check if we have permissions
          //SynEdit1.Lines.Clear;
          SaveToFile(result);
        except
          on E: Exception do
          begin
            MessageDlg(E.Message, mtError, [mbOk], 0);
            Application.Terminate;
            result := '';
            exit;
          end;
        end;
      end;
 
      TFastPHPConfig.ScrapFile := result;
      FScrapFile := result;
    end;
  end;
end;
 
procedure TForm1.Help;
var
  IndexFile, chmFile, w, OriginalWord, url: string;
  internalHtmlFile: string;
resourcestring
  SChmFileNotAValidPHPDocumentation = 'The CHM file is not a valid PHP documentation. Cannot use help.';
  SUnknownErrorCannotUseHelp = 'Unknown error. Cannot use help.';
  SNoHelpAvailable = 'No help for "%s" available';
begin
  if not Assigned(ChmIndex) then
  begin
    IndexFile := TFastPHPConfig.HelpIndex;
    IndexFile := ChangeFileExt(IndexFile, '.ini'); // Just to be sure. Maybe someone wrote manually the ".chm" file in there
    if FileExists(IndexFile) then
    begin
      ChmIndex := TMemIniFile.Create(IndexFile);
    end;
  end;
 
  if Assigned(ChmIndex) then
  begin
    IndexFile := TFastPHPConfig.HelpIndex;
    // We don't check if IndexFile still exists. It is not important since we have ChmIndex pre-loaded in memory
 
    chmFile := ChangeFileExt(IndexFile, '.chm');
    if not FileExists(chmFile) then
    begin
      FreeAndNil(ChmIndex);
    end;
  end;
 
  if not Assigned(ChmIndex) then
  begin
    if not OpenDialog1.Execute then exit;
 
    chmFile := OpenDialog1.FileName;
    if not FileExists(chmFile) then exit;
 
    IndexFile := ChangeFileExt(chmFile, '.ini');
 
    if not FileExists(IndexFile) then
    begin
      Panel1.Align := alClient;
      Panel1.Visible := true;
      Panel1.BringToFront;
      Screen.Cursor := crHourGlass;
      Application.ProcessMessages;
      try
        if not ParseCHM(chmFile) then
        begin
          MessageDlg(SChmFileNotAValidPHPDocumentation, mtError, [mbOk], 0);
          exit;
        end;
      finally
        Screen.Cursor := crDefault;
        Panel1.Visible := false;
      end;
 
      if not FileExists(IndexFile) then
      begin
        MessageDlg(SUnknownErrorCannotUseHelp, mtError, [mbOk], 0);
        exit;
      end;
    end;
 
    TFastPHPConfig.HelpIndex := IndexFile;
 
    ChmIndex := TMemIniFile.Create(IndexFile);
  end;
 
  w := GetWordUnderCaret(SynEdit1);
  if w = '' then exit;
  {$IFDEF UNICODE}
  if CharInSet(w[1], ['0'..'9']) then exit;
  {$ELSE}
  if w[1] in ['0'..'9'] then exit;
  {$ENDIF}
 
  Originalword := w;
//  w := StringReplace(w, '_', '-', [rfReplaceAll]);
  w := LowerCase(w);
  CurSearchTerm := w;
 
  internalHtmlFile := ChmIndex.ReadString('function', CurSearchTerm, ''); // do not translate
  if internalHtmlFile = '' then
    internalHtmlFile := ChmIndex.ReadString('_HelpWords_', CurSearchTerm, ''); // do not translate
  if internalHtmlFile = '' then
  begin
    HelpTabsheet.TabVisible := false;
    HlpPrevPageIndex := -1;
    ShowMessageFmt(SNoHelpAvailable, [Originalword]);
    Exit;
  end;
 
  url := 'mk:@MSITStore:'+ChmFile+'::'+internalHtmlFile;
 
  HlpPrevPageIndex := PageControl2.ActivePageIndex; // Return by pressing ESC
  HelpTabsheet.TabVisible := true;
  PageControl2.ActivePage := HelpTabsheet;
  WebBrowser2.Navigate(url);
  WebBrowser2.Wait;
end;
 
procedure TForm1.GotoLineNo(LineNo:integer);
var
  line: string;
  i: integer;
begin
  SynEdit1.GotoLineAndCenter(LineNo);
 
  // Skip indent
  line := SynEdit1.Lines[SynEdit1.CaretY];
  for i := 1 to Length(line) do
  begin
    {$IFDEF UNICODE}
    if not CharInSet(line[i], [' ', #9]) then
    {$ELSE}
    if not (line[i] in [' ', #9]) then
    {$ENDIF}
    begin
      SynEdit1.CaretX := i-1;
      break;
    end;
  end;
 
  PageControl2.ActivePage := CodeTabsheet;
  if SynEdit1.CanFocus then SynEdit1.SetFocus;
end;
 
procedure TForm1.PageControl2Changing(Sender: TObject;
  var AllowChange: Boolean);
begin
  if PageControl2.ActivePage = HelpTabsheet then
    HlpPrevPageIndex := -1
  else
    HlpPrevPageIndex := PageControl2.ActivePageIndex;
 
  AllowChange := true;
end;
 
procedure TForm1.Memo2DblClick(Sender: TObject);
var
  line: string;
 
  procedure _process(toFind: string);
  var
    p, lineno: integer;
  begin
    if FileSystemCaseSensitive then
      p := Pos(toFind, line)
    else
      p := Pos(LowerCase(toFind), LowerCase(line));
    if p <> 0 then
    begin
      line := copy(line, p+length(toFind), 99);
      if not TryStrToInt(line, lineno) then exit;
      GotoLineNo(lineno);
    end;
  end;
 
begin
  line := memo2.Lines.Strings[Memo2.CaretPos.Y];
 
  {$REGION 'Possibility 1: filename.php:lineno'}
  _process(ExtractFileName(GetScrapFile) + ':');
  {$ENDREGION}
 
  {$REGION 'Possibility 2: on line xx'}
  _process(ExtractFileName(GetScrapFile) + ' on line '); // do not translate!
  {$ENDREGION}
end;
 
procedure TForm1.Memo2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if ((ssCtrl in Shift) and (Key = 65)) then TMemo(Sender).SelectAll;
end;
 
function TForm1.MarkUpLineReference(cont: string): string;
 
  procedure _process(toFind: string);
  var
    p, a, b: integer;
    num: integer;
    insert_a, insert_b: string;
  begin
    if FileSystemCaseSensitive then
      p := Pos(toFind, cont)
    else
      p := Pos(LowerCase(toFind), LowerCase(cont));
    while p >= 1 do
    begin
      a := p;
      b := p + length(toFind);
      num := 0;
      {$IFDEF UNICODE}
      while CharInSet(cont[b], ['0'..'9']) do
      {$ELSE}
      while cont[b] in ['0'..'9'] do
      {$ENDIF}
      begin
        num := num*10 + StrToInt(cont[b]);
        inc(b);
      end;
 
      insert_b := '</a>';
      insert_a := '<a href="' + FASTPHP_GOTO_URI_PREFIX + IntToStr(num) + '">';
 
      insert(insert_b, cont, b);
      insert(insert_a, cont, a);
 
      p := b + Length(insert_a) + Length(insert_b);
 
      p := PosEx(toFind, cont, p+1);
    end;
  end;
 
begin
  {$REGION 'Possibility 1: filename.php:lineno'}
  _process(ExtractFileName(GetScrapFile) + ':');
  {$ENDREGION}
 
  {$REGION 'Possibility 2: on line xx'}
  _process(ExtractFileName(GetScrapFile) + ' on line '); // do not translate!
  {$ENDREGION}
 
  result := cont;
end;
 
function TForm1.InputRequestCallback(var data: AnsiString): boolean;
begin
  data := UTF8Encode(SynEdit1.Text);
  result := true;
end;
 
function TForm1.IsThemeDark: boolean;
begin
  result := Assigned(TStyleManager.ActiveStyle) and (TStyleManager.ActiveStyle.Name<>'Windows');
end;
 
function TForm1.OutputNotifyCallback(const data: AnsiString): boolean;
begin
  result := TreeView1.FillWithFastPHPData(string(data));
end;
 
end.
 

Rev 96	Rev 97
1	unit EditorMain;	1	unit EditorMain;
2		2
3	{$Include 'FastPHP.inc'}	3	{$Include 'FastPHP.inc'}
4		4
5	(*	5	(*
6	This program requires	6	This program requires
7	- Microsoft Internet Controls (TWebBrowser)	7	- Microsoft Internet Controls (TWebBrowser)
8	If you are using Delphi 10.1 Starter Edition, please import the ActiveX TLB	8	If you are using Delphi 10.1 Starter Edition, please import the ActiveX TLB
9	"Microsoft Internet Controls"	9	"Microsoft Internet Controls"
10	- SynEdit	10	- SynEdit
11	You can obtain SynEdit via Embarcadero GetIt	11	You can obtain SynEdit via Embarcadero GetIt
12	*)	12	*)
13		13
14	// TODO: "crHourGlass" does not work if F9 is pressed!	14	// TODO: "crHourGlass" does not work if F9 is pressed!
15	// TODO: if a scrapfile is already open, create a new scrap file (scrap2.php)	15	// TODO: if a scrapfile is already open, create a new scrap file (scrap2.php)
16	// TODO: localize	16	// TODO: localize
17	// TODO: wieso geht copy paste im twebbrowser nicht???	17	// TODO: wieso geht copy paste im twebbrowser nicht???
18	// TODO: Wieso dauert webbrowser1 erste kompilierung so lange???	18	// TODO: Wieso dauert webbrowser1 erste kompilierung so lange???
19	// TODO: wieso kommt syntax fehler zweimal? einmal stderr einmal stdout?	19	// TODO: wieso kommt syntax fehler zweimal? einmal stderr einmal stdout?
20	// TODO: Browser titlebar (link preview)	20	// TODO: Browser titlebar (link preview)
21	// TODO: "jump to next/prev todo" buttons/shortcuts	21	// TODO: "jump to next/prev todo" buttons/shortcuts
22	// TODO: "increase/decrease indent" buttons/shortcuts	22	// TODO: "increase/decrease indent" buttons/shortcuts
23	// TODO: Solve all compiler warnings, especially in regards Encoding	23	// TODO: Solve all compiler warnings, especially in regards Encoding
24		24
25	// Note in re Unicode:	25	// Note in re Unicode:
26	// - In Embarcadero® Delphi 10.4 Version 27.0.40680.4203:	26	// - In Embarcadero® Delphi 10.4 Version 27.0.40680.4203:
27	// SynEdit correctly detects UTF-8 files without BOM as well as ANSI files with Umlauts.	27	// SynEdit correctly detects UTF-8 files without BOM as well as ANSI files with Umlauts.
28	// (Previous versions could not detect UTF-8 files without BOM?!)	28	// (Previous versions could not detect UTF-8 files without BOM?!)
29	// - If BOM is existing, it will be removed. (which is good, because this is defined by PSR-1)	29	// - If BOM is existing, it will be removed. (which is good, because this is defined by PSR-1)
30		30
31	// Small things:	31	// Small things:
32	// - The scroll bars of SynEdit are not affected by the dark theme	32	// - The scroll bars of SynEdit are not affected by the dark theme
33	// - dark theme full screen: doubleclick to desktop pixel "0,0" cannot be used to close the app	33	// - dark theme full screen: doubleclick to desktop pixel "0,0" cannot be used to close the app
34		34
35	// Future ideas	35	// Future ideas
36	// - code insight	36	// - code insight
37	// - verschiedene php versionen?	37	// - verschiedene php versionen?
38	// - webbrowser1 nur laden, wenn man den tab anw�hlt?	38	// - webbrowser1 nur laden, wenn man den tab anw�hlt?
39	// - doppelklick auf tab soll diesen schlie�en	39	// - doppelklick auf tab soll diesen schlie�en
40	// - Onlinehelp (www) aufrufen oder CHM datei	40	// - Onlinehelp (www) aufrufen oder CHM datei
41	// - Let all colors be adjustable	41	// - Let all colors be adjustable
42	// - code in bildschirmmitte (horizontal)?	42	// - code in bildschirmmitte (horizontal)?
43	// - search in files of a directory	43	// - search in files of a directory
44	// - Files in multiple tabs?	44	// - Files in multiple tabs?
45	// - Configurable tabulator display-width	45	// - Configurable tabulator display-width
46		46
47	interface	47	interface
48		48
49	uses	49	uses
50	// TODO: "{$IFDEF USE_SHDOCVW_TLB}_TLB{$ENDIF}" does not work with Delphi 10.2	50	// TODO: "{$IFDEF USE_SHDOCVW_TLB}_TLB{$ENDIF}" does not work with Delphi 10.2
51	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,	51	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
52	Dialogs, StdCtrls, OleCtrls, ComCtrls, ExtCtrls, ToolWin, IniFiles,	52	Dialogs, StdCtrls, OleCtrls, ComCtrls, ExtCtrls, ToolWin, IniFiles,
53	SynEditHighlighter, SynHighlighterPHP, SynEdit, ShDocVw, FindReplace,	53	SynEditHighlighter, SynHighlighterPHP, SynEdit, ShDocVw, FindReplace,
54	ActnList, SynEditMiscClasses, SynEditSearch, RunPHP, ImgList, SynUnicode,	54	ActnList, SynEditMiscClasses, SynEditSearch, RunPHP, ImgList, SynUnicode,
55	System.ImageList, System.Actions, Vcl.Menus, Vcl.Themes, System.UITypes,	55	System.ImageList, System.Actions, Vcl.Menus, Vcl.Themes, System.UITypes,
56	SynEditCodeFolding;	56	SynEditCodeFolding;
57		57
58	{.$DEFINE OnlineHelp}	58	{.$DEFINE OnlineHelp}
59		59
60	type	60	type
61	TForm1 = class(TForm)	61	TForm1 = class(TForm)
62	PageControl1: TPageControl;	62	PageControl1: TPageControl;
63	PlaintextTabSheet: TTabSheet;	63	PlaintextTabSheet: TTabSheet;
64	HtmlTabSheet: TTabSheet;	64	HtmlTabSheet: TTabSheet;
65	Memo2: TMemo;	65	Memo2: TMemo;
66	WebBrowser1: TWebBrowser;	66	WebBrowser1: TWebBrowser;
67	Splitter1: TSplitter;	67	Splitter1: TSplitter;
68	PageControl2: TPageControl;	68	PageControl2: TPageControl;
69	CodeTabsheet: TTabSheet;	69	CodeTabsheet: TTabSheet;
70	HelpTabsheet: TTabSheet;	70	HelpTabsheet: TTabSheet;
71	WebBrowser2: TWebBrowser;	71	WebBrowser2: TWebBrowser;
72	OpenDialog1: TOpenDialog;	72	OpenDialog1: TOpenDialog;
73	Panel1: TPanel;	73	Panel1: TPanel;
74	OpenDialog3: TOpenDialog;	74	OpenDialog3: TOpenDialog;
75	SynEdit1: TSynEdit;	75	SynEdit1: TSynEdit;
76	SynPHPSyn1: TSynPHPSyn;	76	SynPHPSyn1: TSynPHPSyn;
77	Panel2: TPanel;	77	Panel2: TPanel;
78	SynEditFocusTimer: TTimer;	78	SynEditFocusTimer: TTimer;
79	Button1: TButton;	79	Button1: TButton;
80	Button2: TButton;	80	Button2: TButton;
81	Button3: TButton;	81	Button3: TButton;
82	Button4: TButton;	82	Button4: TButton;
83	Button5: TButton;	83	Button5: TButton;
84	Button6: TButton;	84	Button6: TButton;
85	ActionList: TActionList;	85	ActionList: TActionList;
86	ActionFind: TAction;	86	ActionFind: TAction;
87	ActionReplace: TAction;	87	ActionReplace: TAction;
88	ActionFindNext: TAction;	88	ActionFindNext: TAction;
89	ActionGoto: TAction;	89	ActionGoto: TAction;
90	ActionSave: TAction;	90	ActionSave: TAction;
91	ActionHelp: TAction;	91	ActionHelp: TAction;
92	ActionRun: TAction;	92	ActionRun: TAction;
93	ActionESC: TAction;	93	ActionESC: TAction;
94	Button7: TButton;	94	Button7: TButton;
95	ActionOpen: TAction;	95	ActionOpen: TAction;
96	Button8: TButton;	96	Button8: TButton;
97	Button9: TButton;	97	Button9: TButton;
98	ActionFindPrev: TAction;	98	ActionFindPrev: TAction;
99	Timer1: TTimer;	99	Timer1: TTimer;
100	ActionSpaceToTab: TAction;	100	ActionSpaceToTab: TAction;
101	Button11: TButton;	101	Button11: TButton;
102	SynEditSearch1: TSynEditSearch;	102	SynEditSearch1: TSynEditSearch;
103	TreeView1: TTreeView;	103	TreeView1: TTreeView;
104	Splitter2: TSplitter;	104	Splitter2: TSplitter;
105	btnLint: TButton;	105	btnLint: TButton;
106	ActionLint: TAction;	106	ActionLint: TAction;
107	ImageList1: TImageList;	107	ImageList1: TImageList;
108	RunPopup: TPopupMenu;	108	RunPopup: TPopupMenu;
109	OpeninIDE1: TMenuItem;	109	OpeninIDE1: TMenuItem;
110	ActionRunConsole: TAction;	110	ActionRunConsole: TAction;
111	Runinconsole1: TMenuItem;	111	Runinconsole1: TMenuItem;
112	SavePopup: TPopupMenu;	112	SavePopup: TPopupMenu;
113	Saveas1: TMenuItem;	113	Saveas1: TMenuItem;
114	Save1: TMenuItem;	114	Save1: TMenuItem;
115	SaveDialog1: TSaveDialog;	115	SaveDialog1: TSaveDialog;
116	BtnSpecialChars: TImage;	116	BtnSpecialChars: TImage;
117	BtnSpecialCharsOff: TImage;	117	BtnSpecialCharsOff: TImage;
118	BtnSpecialCharsOn: TImage;	118	BtnSpecialCharsOn: TImage;
119	BtnLightOn: TImage;	119	BtnLightOn: TImage;
120	BtnLightOff: TImage;	120	BtnLightOff: TImage;
121	BtnLight: TImage;	121	BtnLight: TImage;
122	StartUpTimer: TTimer;	122	StartUpTimer: TTimer;
123	FileModTimer: TTimer;	123	FileModTimer: TTimer;
124	GotoPHPdir1: TMenuItem;	124	GotoPHPdir1: TMenuItem;
125	PHPShell1: TMenuItem;	125	PHPShell1: TMenuItem;
126	ActionSaveAs: TAction;	126	ActionSaveAs: TAction;
127	ActionGoToPHPDir: TAction;	127	ActionGoToPHPDir: TAction;
128	ActionPHPInteractiveShell: TAction;	128	ActionPHPInteractiveShell: TAction;
129	procedure Run(Sender: TObject);	129	procedure Run(Sender: TObject);
130	procedure RunConsole(Sender: TObject);	130	procedure RunConsole(Sender: TObject);
131	procedure FormShow(Sender: TObject);	131	procedure FormShow(Sender: TObject);
132	procedure FormCreate(Sender: TObject);	132	procedure FormCreate(Sender: TObject);
133	procedure FormDestroy(Sender: TObject);	133	procedure FormDestroy(Sender: TObject);
134	procedure FormClose(Sender: TObject; var Action: TCloseAction);	134	procedure FormClose(Sender: TObject; var Action: TCloseAction);
135	procedure PageControl2Changing(Sender: TObject; var AllowChange: Boolean);	135	procedure PageControl2Changing(Sender: TObject; var AllowChange: Boolean);
136	procedure Memo2DblClick(Sender: TObject);	136	procedure Memo2DblClick(Sender: TObject);
137	(*	137	(*
138	{$IFDEF USE_SHDOCVW_TLB}	138	{$IFDEF USE_SHDOCVW_TLB}
139	*)	139	*)
140	procedure WebBrowser1BeforeNavigate2(ASender: TObject;	140	procedure WebBrowser1BeforeNavigate2(ASender: TObject;
141	const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,	141	const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
142	Headers: OleVariant; var Cancel: WordBool);	142	Headers: OleVariant; var Cancel: WordBool);
143	(*	143	(*
144	{$ELSE}	144	{$ELSE}
145	procedure WebBrowser1BeforeNavigate2(ASender: TObject;	145	procedure WebBrowser1BeforeNavigate2(ASender: TObject;
146	const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,	146	const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
147	Headers: OleVariant; var Cancel: WordBool);	147	Headers: OleVariant; var Cancel: WordBool);
148	{$ENDIF}	148	{$ENDIF}
149	*)	149	*)
150	procedure BeforeNavigate(const URL: OleVariant; var Cancel: WordBool);	150	procedure BeforeNavigate(const URL: OleVariant; var Cancel: WordBool);
151	procedure SynEditFocusTimerTimer(Sender: TObject);	151	procedure SynEditFocusTimerTimer(Sender: TObject);
152	procedure ActionFindExecute(Sender: TObject);	152	procedure ActionFindExecute(Sender: TObject);
153	procedure ActionReplaceExecute(Sender: TObject);	153	procedure ActionReplaceExecute(Sender: TObject);
154	procedure ActionFindNextExecute(Sender: TObject);	154	procedure ActionFindNextExecute(Sender: TObject);
155	procedure ActionGotoExecute(Sender: TObject);	155	procedure ActionGotoExecute(Sender: TObject);
156	procedure ActionSaveExecute(Sender: TObject);	156	procedure ActionSaveExecute(Sender: TObject);
157	procedure ActionHelpExecute(Sender: TObject);	157	procedure ActionHelpExecute(Sender: TObject);
158	procedure ActionRunExecute(Sender: TObject);	158	procedure ActionRunExecute(Sender: TObject);
159	procedure ActionESCExecute(Sender: TObject);	159	procedure ActionESCExecute(Sender: TObject);
160	procedure SynEdit1MouseWheelDown(Sender: TObject; Shift: TShiftState;	160	procedure SynEdit1MouseWheelDown(Sender: TObject; Shift: TShiftState;
161	MousePos: TPoint; var Handled: Boolean);	161	MousePos: TPoint; var Handled: Boolean);
162	procedure SynEdit1MouseWheelUp(Sender: TObject; Shift: TShiftState;	162	procedure SynEdit1MouseWheelUp(Sender: TObject; Shift: TShiftState;
163	MousePos: TPoint; var Handled: Boolean);	163	MousePos: TPoint; var Handled: Boolean);
164	procedure ActionOpenExecute(Sender: TObject);	164	procedure ActionOpenExecute(Sender: TObject);
165	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);	165	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
166	procedure Memo2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);	166	procedure Memo2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
167	procedure ActionFindPrevExecute(Sender: TObject);	167	procedure ActionFindPrevExecute(Sender: TObject);
168	procedure SynEdit1MouseCursor(Sender: TObject;	168	procedure SynEdit1MouseCursor(Sender: TObject;
169	const aLineCharPos: TBufferCoord; var aCursor: TCursor);	169	const aLineCharPos: TBufferCoord; var aCursor: TCursor);
170	procedure Timer1Timer(Sender: TObject);	170	procedure Timer1Timer(Sender: TObject);
171	procedure ActionSpaceToTabExecute(Sender: TObject);	171	procedure ActionSpaceToTabExecute(Sender: TObject);
172	procedure TreeView1DblClick(Sender: TObject);	172	procedure TreeView1DblClick(Sender: TObject);
173	procedure SynEdit1GutterClick(Sender: TObject; Button: TMouseButton; X, Y,	173	procedure SynEdit1GutterClick(Sender: TObject; Button: TMouseButton; X, Y,
174	Line: Integer; Mark: TSynEditMark);	174	Line: Integer; Mark: TSynEditMark);
175	procedure SynEdit1PaintTransient(Sender: TObject; Canvas: TCanvas;	175	procedure SynEdit1PaintTransient(Sender: TObject; Canvas: TCanvas;
176	TransientType: TTransientType);	176	TransientType: TTransientType);
177	procedure ActionLintExecute(Sender: TObject);	177	procedure ActionLintExecute(Sender: TObject);
178	procedure ActionRunConsoleExecute(Sender: TObject);	178	procedure ActionRunConsoleExecute(Sender: TObject);
179	procedure SynEdit1Change(Sender: TObject);	179	procedure SynEdit1Change(Sender: TObject);
180	procedure BtnSpecialCharsClick(Sender: TObject);	180	procedure BtnSpecialCharsClick(Sender: TObject);
181	procedure WebBrowser1WindowClosing(ASender: TObject;	181	procedure WebBrowser1WindowClosing(ASender: TObject;
182	IsChildWindow: WordBool; var Cancel: WordBool);	182	IsChildWindow: WordBool; var Cancel: WordBool);
183	procedure BtnLightClick(Sender: TObject);	183	procedure BtnLightClick(Sender: TObject);
184	procedure StartUpTimerTimer(Sender: TObject);	184	procedure StartUpTimerTimer(Sender: TObject);
185	procedure FileModTimerTimer(Sender: TObject);	185	procedure FileModTimerTimer(Sender: TObject);
186	procedure SynEdit1DropFiles(Sender: TObject; X, Y: Integer;	186	procedure SynEdit1DropFiles(Sender: TObject; X, Y: Integer;
187	AFiles: TStrings);	187	AFiles: TStrings);
188	procedure ActionSaveAsExecute(Sender: TObject);	188	procedure ActionSaveAsExecute(Sender: TObject);
189	procedure ActionGoToPHPDirExecute(Sender: TObject);	189	procedure ActionGoToPHPDirExecute(Sender: TObject);
190	procedure ActionPHPInteractiveShellExecute(Sender: TObject);	190	procedure ActionPHPInteractiveShellExecute(Sender: TObject);
191	private	191	private
192	hMutex: THandle;	192	hMutex: THandle;
193	CurSearchTerm: string;	193	CurSearchTerm: string;
194	HlpPrevPageIndex: integer;	194	HlpPrevPageIndex: integer;
195	SrcRep: TSynEditFindReplace;	195	SrcRep: TSynEditFindReplace;
196	{$IFDEF OnlineHelp}	196	{$IFDEF OnlineHelp}
197	gOnlineHelpWord: string;	197	gOnlineHelpWord: string;
198	{$ENDIF}	198	{$ENDIF}
199	FileModLast: TDateTime;	199	FileModLast: TDateTime;
200	FormShowRanOnce: boolean;	200	FormShowRanOnce: boolean;
201	BrowserLoadedOnce: boolean;	201	BrowserLoadedOnce: boolean;
202	procedure Help;	202	procedure Help;
203	function InputRequestCallback(var data: AnsiString): boolean;	203	function InputRequestCallback(var data: AnsiString): boolean;
204	function OutputNotifyCallback(const data: AnsiString): boolean;	204	function OutputNotifyCallback(const data: AnsiString): boolean;
205	procedure RightTrimAll;	205	procedure RightTrimAll;
206	protected	206	protected
207	ChmIndex: TMemIniFile;	207	ChmIndex: TMemIniFile;
208	FScrapFile: string;	208	FScrapFile: string;
209	FSaveAsFilename: string;	209	FSaveAsFilename: string;
210	codeExplorer: TRunCodeExplorer;	210	codeExplorer: TRunCodeExplorer;
211	procedure GotoLineNo(LineNo: integer);	211	procedure GotoLineNo(LineNo: integer);
212	function GetScrapFile: string;	212	function GetScrapFile: string;
213	procedure StartCodeExplorer;	213	procedure StartCodeExplorer;
214	procedure RefreshModifySign;	214	procedure RefreshModifySign;
215	procedure Theme_Light;	215	procedure Theme_Light;
216	procedure Theme_Dark;	216	procedure Theme_Dark;
217	function IsThemeDark: boolean;	217	function IsThemeDark: boolean;
218	function MarkUpLineReference(cont: string): string;	218	function MarkUpLineReference(cont: string): string;
219	function ContainsUnicodeCharsInAnsiFile: boolean;	219	function ContainsUnicodeCharsInAnsiFile: boolean;
220	procedure SaveToFile(filename: string);	220	procedure SaveToFile(filename: string);
221	end;	221	end;
222		222
223	var	223	var
224	Form1: TForm1;	224	Form1: TForm1;
225		225
226	implementation	226	implementation
227		227
228	{$R *.dfm}	228	{$R *.dfm}
229		229
230	{$R Cursors.res}	230	{$R Cursors.res}
231		231
232	uses	232	uses
233	Functions, StrUtils, WebBrowserUtils, FastPHPUtils, Math, ShellAPI, RichEdit,	233	Functions, StrUtils, WebBrowserUtils, FastPHPUtils, Math, ShellAPI, RichEdit,
234	FastPHPTreeView, ImageListEx, FastPHPConfig;	234	FastPHPTreeView, ImageListEx, FastPHPConfig;
235		235
236	const	236	const
237	crMouseGutter = 1;	237	crMouseGutter = 1;
238		238
239	procedure TForm1.RefreshModifySign;	239	procedure TForm1.RefreshModifySign;
240	var	240	var
241	tmp: string;	241	tmp: string;
242	begin	242	begin
243	tmp := Caption;	243	tmp := Caption;
244		244
245	tmp := StringReplace(tmp, '*', '', [rfReplaceAll]);	245	tmp := StringReplace(tmp, '*', '', [rfReplaceAll]);
246	if SynEdit1.Modified then tmp := tmp + '*';	246	if SynEdit1.Modified then tmp := tmp + '*';
247		247
248	if Caption <> tmp then Caption := tmp;	248	if Caption <> tmp then Caption := tmp;
249	end;	249	end;
250		250
251	procedure TForm1.ActionFindNextExecute(Sender: TObject);	251	procedure TForm1.ActionFindNextExecute(Sender: TObject);
252	begin	252	begin
253	SrcRep.FindNext;	253	SrcRep.FindNext;
254	end;	254	end;
255		255
256	procedure TForm1.ActionFindPrevExecute(Sender: TObject);	256	procedure TForm1.ActionFindPrevExecute(Sender: TObject);
257	begin	257	begin
258	SrcRep.FindPrev;	258	SrcRep.FindPrev;
259	end;	259	end;
260		260
261	procedure TForm1.ActionGotoExecute(Sender: TObject);	261	procedure TForm1.ActionGotoExecute(Sender: TObject);
262	var	262	var
263	val: string;	263	val: string;
264	lineno: integer;	264	lineno: integer;
265	resourcestring	265	resourcestring
266	SGoTo = 'Go to';	266	SGoTo = 'Go to';
267	SLineNumber = 'Line number:';	267	SLineNumber = 'Line number:';
268	begin	268	begin
269	// TODO: VK_LMENU does not work! only works with AltGr but not Alt	269	// TODO: VK_LMENU does not work! only works with AltGr but not Alt
270	// http://stackoverflow.com/questions/16828250/delphi-xe2-how-to-prevent-the-alt-key-stealing-focus ?	270	// http://stackoverflow.com/questions/16828250/delphi-xe2-how-to-prevent-the-alt-key-stealing-focus ?
271		271
272	if not InputQuery(SGoTo, SLineNumber, val) or	272	if not InputQuery(SGoTo, SLineNumber, val) or
273	not TryStrToInt(val, lineno) then	273	not TryStrToInt(val, lineno) then
274	begin	274	begin
275	if SynEdit1.CanFocus then SynEdit1.SetFocus;	275	if SynEdit1.CanFocus then SynEdit1.SetFocus;
276	exit;	276	exit;
277	end;	277	end;
278	GotoLineNo(lineno);	278	GotoLineNo(lineno);
279	end;	279	end;
280		280
281	procedure TForm1.ActionGoToPHPDirExecute(Sender: TObject);	281	procedure TForm1.ActionGoToPHPDirExecute(Sender: TObject);
282	var	282	var
283	phpExe: string;	283	phpExe: string;
284	begin	284	begin
285	phpExe := GetPHPExe;	285	phpExe := GetPHPExe;
286	if phpExe <> '' then	286	if phpExe <> '' then
287	ShellExecute(Handle, 'open', 'explorer.exe', PChar(ExtractFilePath(phpExe)), '', SW_NORMAL);	287	ShellExecute(Handle, 'open', 'explorer.exe', PChar(ExtractFilePath(phpExe)), '', SW_NORMAL);
288	end;	288	end;
289		289
290	procedure TForm1.ActionHelpExecute(Sender: TObject);	290	procedure TForm1.ActionHelpExecute(Sender: TObject);
291	begin	291	begin
292	Help;	292	Help;
293	if PageControl2.ActivePage = HelpTabsheet then	293	if PageControl2.ActivePage = HelpTabsheet then
294	WebBrowser2.SetFocus	294	WebBrowser2.SetFocus
295	else if PageControl2.ActivePage = CodeTabsheet then	295	else if PageControl2.ActivePage = CodeTabsheet then
296	SynEdit1.SetFocus;	296	SynEdit1.SetFocus;
297	end;	297	end;
298		298
299	procedure TForm1.ActionLintExecute(Sender: TObject);	299	procedure TForm1.ActionLintExecute(Sender: TObject);
300	begin	300	begin
301	Run(Sender);	301	Run(Sender);
302	SynEdit1.SetFocus;	302	SynEdit1.SetFocus;
303	end;	303	end;
304		304
305	procedure TForm1.ActionOpenExecute(Sender: TObject);	305	procedure TForm1.ActionOpenExecute(Sender: TObject);
306	begin	306	begin
307	If OpenDialog3.Execute then	307	If OpenDialog3.Execute then
308	begin	308	begin
309	ShellExecute(0, 'open', PChar(ParamStr(0)), PChar('"' + OpenDialog3.FileName + '"'), '', SW_NORMAL);	309	ShellExecute(0, 'open', PChar(ParamStr(0)), PChar('"' + OpenDialog3.FileName + '"'), '', SW_NORMAL);
310	end;	310	end;
311	end;	311	end;
312		312
313	procedure TForm1.ActionPHPInteractiveShellExecute(Sender: TObject);	313	procedure TForm1.ActionPHPInteractiveShellExecute(Sender: TObject);
314	var	314	var
315	phpExe: string;	315	phpExe: string;
316	begin	316	begin
317	phpExe := GetPHPExe;	317	phpExe := GetPHPExe;
318	if phpExe <> '' then	318	if phpExe <> '' then
319	ShellExecute(Handle, 'open', PChar(phpExe), '-a', PChar(ExtractFilePath(phpExe)), SW_NORMAL);	319	ShellExecute(Handle, 'open', PChar(phpExe), '-a', PChar(ExtractFilePath(phpExe)), SW_NORMAL);
320	end;	320	end;
321		321
322	procedure TForm1.ActionReplaceExecute(Sender: TObject);	322	procedure TForm1.ActionReplaceExecute(Sender: TObject);
323	begin	323	begin
324	SrcRep.ReplaceExecute;	324	SrcRep.ReplaceExecute;
325	end;	325	end;
326		326
327	procedure TForm1.ActionRunConsoleExecute(Sender: TObject);	327	procedure TForm1.ActionRunConsoleExecute(Sender: TObject);
328	begin	328	begin
329	RunConsole(Sender);	329	RunConsole(Sender);
330	SynEdit1.SetFocus;	330	SynEdit1.SetFocus;
331	end;	331	end;
332		332
333	procedure TForm1.ActionRunExecute(Sender: TObject);	333	procedure TForm1.ActionRunExecute(Sender: TObject);
334	begin	334	begin
335	Run(Sender);	335	Run(Sender);
336	SynEdit1.SetFocus;	336	SynEdit1.SetFocus;
337	end;	337	end;
338		338
339	procedure TForm1.RightTrimAll;	339	procedure TForm1.RightTrimAll;
340	var	340	var
341	i: integer;	341	i: integer;
342	begin	342	begin
343	for i := 0 to SynEdit1.Lines.Count-1 do	343	for i := 0 to SynEdit1.Lines.Count-1 do
344	begin	344	begin
345	SynEdit1.Lines.Strings[i] := TrimRight(SynEdit1.Lines.Strings[i]);	345	SynEdit1.Lines.Strings[i] := TrimRight(SynEdit1.Lines.Strings[i]);
346	end;	346	end;
347		347
348	(*	348	(*
349	while (SynEdit1.Lines.Count > 0) and (SynEdit1.Lines.Strings[SynEdit1.Lines.Count-1] = '') do	349	while (SynEdit1.Lines.Count > 0) and (SynEdit1.Lines.Strings[SynEdit1.Lines.Count-1] = '') do
350	begin	350	begin
351	SynEdit1.Lines.Delete(SynEdit1.Lines.Count-1);	351	SynEdit1.Lines.Delete(SynEdit1.Lines.Count-1);
352	end;	352	end;
353	if SynEdit1.SelStart > Length(SynEdit1.Text)-1 then	353	if SynEdit1.SelStart > Length(SynEdit1.Text)-1 then
354	begin	354	begin
355	// TODO: This code does not work...	355	// TODO: This code does not work...
356	SynEdit1.SelStart := Length(SynEdit1.Text)-1;	356	SynEdit1.SelStart := Length(SynEdit1.Text)-1;
357	SynEdit1.SelEnd := Length(SynEdit1.Text)-1;	357	SynEdit1.SelEnd := Length(SynEdit1.Text)-1;
358	end;	358	end;
359	*)	359	*)
360	end;	360	end;
361		361
362	procedure TForm1.ActionSaveAsExecute(Sender: TObject);	362	procedure TForm1.ActionSaveAsExecute(Sender: TObject);
363	var	363	var
364	hMutexNew: THandle;	364	hMutexNew: THandle;
365	resourcestring	365	resourcestring
366	SCannotSaveBecauseMutex = 'Cannot save because file "%s", because it is alrady open in another FastPHP window!';	366	SCannotSaveBecauseMutex = 'Cannot save because file "%s", because it is alrady open in another FastPHP window!';
367	begin	367	begin
368	if SaveDialog1.Execute then	368	if SaveDialog1.Execute then
369	begin	369	begin
370	{$REGION 'Switch mutex'}	370	{$REGION 'Switch mutex'}
371	hMutexNew := CreateMutex(nil, True, PChar('FastPHP'+md5(UpperCase(SaveDialog1.FileName))));	371	hMutexNew := CreateMutex(nil, True, PChar('FastPHP'+md5(UpperCase(SaveDialog1.FileName))));
372	if GetLastError = ERROR_ALREADY_EXISTS then	372	if GetLastError = ERROR_ALREADY_EXISTS then
373	begin	373	begin
374	ShowMessageFmt(SCannotSaveBecauseMutex, [SaveDialog1.FileName]);	374	ShowMessageFmt(SCannotSaveBecauseMutex, [SaveDialog1.FileName]);
375	Close;	375	Close;
376	end;	376	end;
377		377
378	if hMutex <> 0 then CloseHandle(hMutex); // Note: ReleaseMutex does not work as expected!	378	if hMutex <> 0 then CloseHandle(hMutex); // Note: ReleaseMutex does not work as expected!
379	hMutex := hMutexNew;	379	hMutex := hMutexNew;
380	{$ENDREGION}	380	{$ENDREGION}
381		381
382	FSaveAsFilename := SaveDialog1.FileName;	382	FSaveAsFilename := SaveDialog1.FileName;
383	Caption := Copy(Caption, 1, Pos(' - ', Caption)-1) + ' - ' + FSaveAsFilename;	383	Caption := Copy(Caption, 1, Pos(' - ', Caption)-1) + ' - ' + FSaveAsFilename;
384	Application.Title := Format('%s - FastPHP', [ExtractFileName(FSaveAsFilename)]); // do not translate!	384	Application.Title := Format('%s - FastPHP', [ExtractFileName(FSaveAsFilename)]); // do not translate!
385	Button7.Click;	385	Button7.Click;
386	end;	386	end;
387	end;	387	end;
388		388
389	procedure TForm1.ActionSaveExecute(Sender: TObject);	389	procedure TForm1.ActionSaveExecute(Sender: TObject);
390	begin	390	begin
391	RightTrimAll;	391	RightTrimAll;
392	SaveToFile(GetScrapFile);	392	SaveToFile(GetScrapFile);
393	SynEdit1.Modified := false;	393	SynEdit1.Modified := false;
394	RefreshModifySign;	394	RefreshModifySign;
395	if SynEdit1.CanFocus then SynEdit1.SetFocus;	395	if SynEdit1.CanFocus then SynEdit1.SetFocus;
396	end;	396	end;
397		397
398	procedure TForm1.ActionSpaceToTabExecute(Sender: TObject);	398	procedure TForm1.ActionSpaceToTabExecute(Sender: TObject);
399		399
400	function SpacesAtBeginning(line: string): integer;	400	function SpacesAtBeginning(line: string): integer;
401	begin	401	begin
402	result := 0;	402	result := 0;
403	if Trim(line) = '' then exit;	403	if Trim(line) = '' then exit;
404	while line[result+1] = ' ' do	404	while line[result+1] = ' ' do
405	begin	405	begin
406	inc(result);	406	inc(result);
407	end;	407	end;
408	end;	408	end;
409		409
410	function GuessIndent(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}): integer;	410	function GuessIndent(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}): integer;
411	function _Check(indent: integer): boolean;	411	function _Check(indent: integer): boolean;
412	var	412	var
413	i: integer;	413	i: integer;
414	begin	414	begin
415	result := true;	415	result := true;
416	for i := 0 to lines.Count-1 do	416	for i := 0 to lines.Count-1 do
417	if SpacesAtBeginning(lines.Strings[i]) mod indent <> 0 then	417	if SpacesAtBeginning(lines.Strings[i]) mod indent <> 0 then
418	begin	418	begin
419	// ShowMessageFmt('Zeile "%s" nicht durch %d teilbar!', [lines.strings[i], indent]);	419	// ShowMessageFmt('Zeile "%s" nicht durch %d teilbar!', [lines.strings[i], indent]);
420	result := false;	420	result := false;
421	exit;	421	exit;
422	end;	422	end;
423	end;	423	end;
424	var	424	var
425	i: integer;	425	i: integer;
426	begin	426	begin
427	for i := 8 downto 2 do	427	for i := 8 downto 2 do
428	begin	428	begin
429	if _Check(i) then	429	if _Check(i) then
430	begin	430	begin
431	result := i;	431	result := i;
432	exit;	432	exit;
433	end;	433	end;
434	end;	434	end;
435	result := -1;	435	result := -1;
436	end;	436	end;
437		437
438	procedure SpaceToTab(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}; indent: integer);	438	procedure SpaceToTab(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}; indent: integer);
439	var	439	var
440	i, spaces: integer;	440	i, spaces: integer;
441	newval: string;	441	newval: string;
442	somethingchanged: boolean;	442	somethingchanged: boolean;
443	begin	443	begin
444	somethingchanged := false;	444	somethingchanged := false;
445	for i := 0 to lines.Count-1 do	445	for i := 0 to lines.Count-1 do
446	begin	446	begin
447	spaces := SpacesAtBeginning(lines.Strings[i]);	447	spaces := SpacesAtBeginning(lines.Strings[i]);
448	newval := StringOfChar(#9, spaces div indent) + StringOfChar(' ', spaces mod indent) + Copy(lines.Strings[i], spaces+1, Length(lines.Strings[i])-spaces);	448	newval := StringOfChar(#9, spaces div indent) + StringOfChar(' ', spaces mod indent) + Copy(lines.Strings[i], spaces+1, Length(lines.Strings[i])-spaces);
449	if lines.Strings[i] <> newval then	449	if lines.Strings[i] <> newval then
450	begin	450	begin
451	somethingchanged := true;	451	somethingchanged := true;
452	lines.Strings[i] := newval;	452	lines.Strings[i] := newval;
453	end;	453	end;
454	end;	454	end;
455	if somethingchanged then	455	if somethingchanged then
456	begin	456	begin
457	SynEdit1Change(SynEdit1); // set the "changed" flag	457	SynEdit1Change(SynEdit1); // set the "changed" flag
458	end;	458	end;
459	end;	459	end;
460		460
461	function SpacesAvailable(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}): boolean;	461	function SpacesAvailable(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}): boolean;
462	var	462	var
463	i, spaces: integer;	463	i, spaces: integer;
464	begin	464	begin
465	for i := 0 to lines.Count-1 do	465	for i := 0 to lines.Count-1 do
466	begin	466	begin
467	spaces := SpacesAtBeginning(lines.Strings[i]);	467	spaces := SpacesAtBeginning(lines.Strings[i]);
468	if spaces > 0 then	468	if spaces > 0 then
469	begin	469	begin
470	result := true;	470	result := true;
471	exit;	471	exit;
472	end;	472	end;
473	end;	473	end;
474	result := false;	474	result := false;
475	exit;	475	exit;
476	end;	476	end;
477		477
478	var	478	var
479	val: string;	479	val: string;
480	ind: integer;	480	ind: integer;
481	resourcestring	481	resourcestring
482	SNoLinesAvailable = 'No lines with spaces at the beginning available';	482	SNoLinesAvailable = 'No lines with spaces at the beginning available';
483	SSpacesToLabs = 'Spaces to tabs';	483	SSpacesToLabs = 'Spaces to tabs';
484	SIndent = 'Indent:';	484	SIndent = 'Indent:';
485	begin	485	begin
486	// TODO: if something is selected, only process the selected part	486	// TODO: if something is selected, only process the selected part
487		487
488	if not SpacesAvailable(SynEdit1.Lines) then	488	if not SpacesAvailable(SynEdit1.Lines) then
489	begin	489	begin
490	MessageDlg(SNoLinesAvailable, mtInformation, [mbOk], 0);	490	MessageDlg(SNoLinesAvailable, mtInformation, [mbOk], 0);
491	exit;	491	exit;
492	end;	492	end;
493		493
494	ind := GuessIndent(SynEdit1.Lines);	494	ind := GuessIndent(SynEdit1.Lines);
495	if ind <> -1 then val := IntToStr(ind);	495	if ind <> -1 then val := IntToStr(ind);
496		496
497	if not InputQuery(SSpacesToLabs, SIndent, val) or	497	if not InputQuery(SSpacesToLabs, SIndent, val) or
498	not TryStrToInt(Trim(val), ind) then	498	not TryStrToInt(Trim(val), ind) then
499	begin	499	begin
500	if SynEdit1.CanFocus then SynEdit1.SetFocus;	500	if SynEdit1.CanFocus then SynEdit1.SetFocus;

Subversion Repositories fastphp

fastphp/trunk/EditorMain.pas – Rev 96 → 97