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: "DragAcceptFiles" does not work with Delphi Dark Design Template !!!
 
// 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
 
// Small things:
// - The scroll bars of SynEdit are not affected by the dark theme
 
// 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
// - Let all colors be adjustable
// - code in bildschirmmitte (horizontal)?
// - search in files of a directory
// - multi tab?
// - DDE (drag n drop)
 
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;
 
{.$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;
    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 Saveas1Click(Sender: TObject);
    procedure Save1Click(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 GotoPHPdir1Click(Sender: TObject);
    procedure PHPShell1Click(Sender: TObject);
  private
    hMutex: THandle;
    CurSearchTerm: string;
    HlpPrevPageIndex: integer;
    SrcRep: TSynEditFindReplace;
    {$IFDEF OnlineHelp}
    gOnlineHelpWord: string;
    {$ENDIF}
    FileModLast: TDateTime;
    procedure Help;
    function InputRequestCallback(var data: AnsiString): boolean;
    function OutputNotifyCallback(const data: AnsiString): boolean;
    procedure RightTrimAll;
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  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;
    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;
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 ?
 
  InputQuery('Go to', 'Line number:', val);
  if not TryStrToInt(val, lineno) then
  begin
    if SynEdit1.CanFocus then SynEdit1.SetFocus;
    exit;
  end;
  GotoLineNo(lineno);
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.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.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;
    begin
      for i := 0 to lines.Count-1 do
      begin
        spaces := SpacesAtBeginning(lines.Strings[i]);
        lines.Strings[i] := StringOfChar(#9, spaces div indent) + StringOfChar(' ', spaces mod indent) + Copy(lines.Strings[i], spaces+1, Length(lines.Strings[i])-spaces);
      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';
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);
 
  InputQuery('Spaces to tabs', 'Indent:', val); // TODO: handle CANCEL correctly...
  if TryStrToInt(Trim(val), ind) then
  begin
    if ind = 0 then exit;
    SpaceToTab(SynEdit1.Lines, ind);
  end;
 
  if SynEdit1.CanFocus then SynEdit1.SetFocus;
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;
 
var
  firstTimeBrowserLoad: boolean = true;
procedure TForm1.Run(Sender: TObject);
var
  bakTS: TTabSheet;
  //ss: TStringStream;
  //bakPos: Int64;
begin
  memo2.Lines.Text := '';
 
  if firstTimeBrowserLoad 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;
    firstTimeBrowserLoad := false;
  end
  else
    Webbrowser1.Clear;
 
  Screen.Cursor := crHourGlass;
  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> flush() mittels ContentCallBack implementieren... ich möchte bei langen scripts statusanzeigen realisieren können mit javascript das stück für stück geladen wird !!!!!!!!
    // TODO 70422 * <fastphp> wenn ein script hängt, soll man es abwürgen dürfen!!!!!!
    memo2.Lines.Text := RunPHPScript(GetScrapFile, Sender=ActionLint, False);
 
    {$REGION 'Show in Web Browser'}
    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.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');
  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');
  Color := clBtnFace;
  Font.Color := clWindowText;
  //Memo2.Font.Color := clWindowText;
  SynEdit1.ActiveLineColor := 14680010;
  SynEdit1.Color := clWindow;
  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
  LNG_CLOSE_REQUEST = 'A script has requested the window to be closed. The window of a standalone script would now close.';
begin
  ShowMessage(LNG_CLOSE_REQUEST);
  TWebBrowser(ASender).Clear;
  Cancel := true;
end;
 
procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
var
   DropH: HDROP;               // drop handle
   DroppedFileCount: Integer;  // number of files dropped
   FileNameLength: Integer;    // length of a dropped file name
   FileName: string;           // a dropped file name
   I: Integer;                 // loops thru all dropped files
   DropPoint: TPoint;          // point where files dropped
 begin
   inherited;
   // Store drop handle from the message
   DropH := Msg.Drop;
   try
     // Get count of files dropped
     DroppedFileCount := DragQueryFile(DropH, $FFFFFFFF, nil, 0);
     // Get name of each file dropped and process it
     for I := 0 to Pred(DroppedFileCount) do
     begin
       // get length of file name
       FileNameLength := DragQueryFile(DropH, I, nil, 0);
       // create string large enough to store file
       SetLength(FileName, FileNameLength);
       // get the file name
       DragQueryFile(DropH, I, PChar(FileName), FileNameLength + 1);
       // process file name (application specific)
       // ... processing code here
       ShellExecute(0, 'open', PChar(ParamStr(0)), PChar('"' + FileName + '"'), '', SW_NORMAL);
     end;
     // Optional: Get point at which files were dropped
     DragQueryPoint(DropH, DropPoint);
     // ... do something with drop point here
   finally
     // Tidy up - release the drop handle
     // don't use DropH again after this
     DragFinish(DropH);
   end;
   // Note we handled message
   Msg.Result := 0;
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);
begin
  FileModTimer.Enabled := false;
  if FileModLast <> FileAge(GetScrapFile) then
  begin
    FileModLast := FileAge(GetScrapFile);
    if SynEdit1.Modified then
    begin
      if MessageDlg('The file was changed in a different application BUT IT WAS ALSO MODIFIED HERE! Reload file AND LOSE CHANGES HERE?', mtWarning, mbYesNoCancel, 0) = mrYes then
      begin
        SynEdit1.Lines.LoadFromFile(GetScrapFile);
      end;
    end
    else
    begin
      if MessageDlg('The file was changed in a different application! Reload file?', 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;
begin
  if SynEdit1.Modified then
  begin
    if (ParamStr(1) <> '') or (FSaveAsFilename <> '') then
    begin
      r := MessageDlg('Do you want to save?', 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)]);
  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;
 
var
  FormShowRanOnce: boolean;
procedure TForm1.FormShow(Sender: TObject);
var
  ScrapFile: string;
  tmpFontSize: integer;
  opts: TSynEditorOptions;
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('File "%s" is alrady open!', [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;
 
procedure TForm1.Save1Click(Sender: TObject);
begin
  Button7.Click;
end;
 
procedure TForm1.Saveas1Click(Sender: TObject);
var
  hMutexNew: THandle;
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('Cannot save because file "%s", because it is alrady open in another FastPHP window!', [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)]);
    Button7.Click;
  end;
end;
 
procedure TForm1.SaveToFile(filename: string);
var
  ss: TStringStream;
  ms: TMemoryStream;
  fs: TFileStream;
  eolStyle: string;
  str: string;
begin
  FileModTimer.Enabled := false;
 
  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
    SynEdit1.Lines.SaveToStream(ms);
    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;
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('File %s does not exist. Create it?', [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('Path does not exist! Please try again.', 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;
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('The CHM file is not a valid PHP documentation. Cannot use help.', mtError, [mbOk], 0);
          exit;
        end;
      finally
        Screen.Cursor := crDefault;
        Panel1.Visible := false;
      end;
 
      if not FileExists(IndexFile) then
      begin
        MessageDlg('Unknown error. Cannot use help.', 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, '');
  if internalHtmlFile = '' then
    internalHtmlFile := ChmIndex.ReadString('_HelpWords_', CurSearchTerm, '');
  if internalHtmlFile = '' then
  begin
    HelpTabsheet.TabVisible := false;
    HlpPrevPageIndex := -1;
    ShowMessageFmt('No help for "%s" available', [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.GotoPHPdir1Click(Sender: TObject);
var
  phpExe: string;
begin
  phpExe := GetPHPExe;
  if phpExe <> '' then
    ShellExecute(Handle, 'open', 'explorer.exe', PChar(ExtractFilePath(phpExe)), '', SW_NORMAL);
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.PHPShell1Click(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.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 ');
  {$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 ');
  {$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(data);
end;
 
end.
 

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

Subversion Repositories fastphp

fastphp/trunk/EditorMain.pas – Rev 86 → 87