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

Subversion Repositories fastphp

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