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);
    procedure SynEdit1DropFiles(Sender: TObject; X, Y: Integer;
      AFiles: TStrings);
  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;
 
  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.SynEdit1DropFiles(Sender: TObject; X, Y: Integer;
  AFiles: TStrings);
var
  FileName: string;
const
  WARN_FILE_COUNT = 10;
begin
  if AFiles.Count > WARN_FILE_COUNT then
  begin
    if not MessageDlg(Format('Are you sure you want to open %d files?', [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');
  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.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 87	Rev 89
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;	116	GotoPHPdir1: TMenuItem;
117	PHPShell1: TMenuItem;	117	PHPShell1: TMenuItem;
118	procedure Run(Sender: TObject);	118	procedure Run(Sender: TObject);
119	procedure RunConsole(Sender: TObject);	119	procedure RunConsole(Sender: TObject);
120	procedure FormShow(Sender: TObject);	120	procedure FormShow(Sender: TObject);
121	procedure FormCreate(Sender: TObject);	121	procedure FormCreate(Sender: TObject);
122	procedure FormDestroy(Sender: TObject);	122	procedure FormDestroy(Sender: TObject);
123	procedure FormClose(Sender: TObject; var Action: TCloseAction);	123	procedure FormClose(Sender: TObject; var Action: TCloseAction);
124	procedure PageControl2Changing(Sender: TObject; var AllowChange: Boolean);	124	procedure PageControl2Changing(Sender: TObject; var AllowChange: Boolean);
125	procedure Memo2DblClick(Sender: TObject);	125	procedure Memo2DblClick(Sender: TObject);
126	(*	126	(*
127	{$IFDEF USE_SHDOCVW_TLB}	127	{$IFDEF USE_SHDOCVW_TLB}
128	*)	128	*)
129	procedure WebBrowser1BeforeNavigate2(ASender: TObject;	129	procedure WebBrowser1BeforeNavigate2(ASender: TObject;
130	const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,	130	const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
131	Headers: OleVariant; var Cancel: WordBool);	131	Headers: OleVariant; var Cancel: WordBool);
132	(*	132	(*
133	{$ELSE}	133	{$ELSE}
134	procedure WebBrowser1BeforeNavigate2(ASender: TObject;	134	procedure WebBrowser1BeforeNavigate2(ASender: TObject;
135	const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,	135	const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
136	Headers: OleVariant; var Cancel: WordBool);	136	Headers: OleVariant; var Cancel: WordBool);
137	{$ENDIF}	137	{$ENDIF}
138	*)	138	*)
139	procedure BeforeNavigate(const URL: OleVariant; var Cancel: WordBool);	139	procedure BeforeNavigate(const URL: OleVariant; var Cancel: WordBool);
140	procedure SynEditFocusTimerTimer(Sender: TObject);	140	procedure SynEditFocusTimerTimer(Sender: TObject);
141	procedure ActionFindExecute(Sender: TObject);	141	procedure ActionFindExecute(Sender: TObject);
142	procedure ActionReplaceExecute(Sender: TObject);	142	procedure ActionReplaceExecute(Sender: TObject);
143	procedure ActionFindNextExecute(Sender: TObject);	143	procedure ActionFindNextExecute(Sender: TObject);
144	procedure ActionGotoExecute(Sender: TObject);	144	procedure ActionGotoExecute(Sender: TObject);
145	procedure ActionSaveExecute(Sender: TObject);	145	procedure ActionSaveExecute(Sender: TObject);
146	procedure ActionHelpExecute(Sender: TObject);	146	procedure ActionHelpExecute(Sender: TObject);
147	procedure ActionRunExecute(Sender: TObject);	147	procedure ActionRunExecute(Sender: TObject);
148	procedure ActionESCExecute(Sender: TObject);	148	procedure ActionESCExecute(Sender: TObject);
149	procedure SynEdit1MouseWheelDown(Sender: TObject; Shift: TShiftState;	149	procedure SynEdit1MouseWheelDown(Sender: TObject; Shift: TShiftState;
150	MousePos: TPoint; var Handled: Boolean);	150	MousePos: TPoint; var Handled: Boolean);
151	procedure SynEdit1MouseWheelUp(Sender: TObject; Shift: TShiftState;	151	procedure SynEdit1MouseWheelUp(Sender: TObject; Shift: TShiftState;
152	MousePos: TPoint; var Handled: Boolean);	152	MousePos: TPoint; var Handled: Boolean);
153	procedure ActionOpenExecute(Sender: TObject);	153	procedure ActionOpenExecute(Sender: TObject);
154	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);	154	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
155	procedure Memo2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);	155	procedure Memo2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
156	procedure ActionFindPrevExecute(Sender: TObject);	156	procedure ActionFindPrevExecute(Sender: TObject);
157	procedure SynEdit1MouseCursor(Sender: TObject;	157	procedure SynEdit1MouseCursor(Sender: TObject;
158	const aLineCharPos: TBufferCoord; var aCursor: TCursor);	158	const aLineCharPos: TBufferCoord; var aCursor: TCursor);
159	procedure Timer1Timer(Sender: TObject);	159	procedure Timer1Timer(Sender: TObject);
160	procedure ActionSpaceToTabExecute(Sender: TObject);	160	procedure ActionSpaceToTabExecute(Sender: TObject);
161	procedure TreeView1DblClick(Sender: TObject);	161	procedure TreeView1DblClick(Sender: TObject);
162	procedure SynEdit1GutterClick(Sender: TObject; Button: TMouseButton; X, Y,	162	procedure SynEdit1GutterClick(Sender: TObject; Button: TMouseButton; X, Y,
163	Line: Integer; Mark: TSynEditMark);	163	Line: Integer; Mark: TSynEditMark);
164	procedure SynEdit1PaintTransient(Sender: TObject; Canvas: TCanvas;	164	procedure SynEdit1PaintTransient(Sender: TObject; Canvas: TCanvas;
165	TransientType: TTransientType);	165	TransientType: TTransientType);
166	procedure ActionLintExecute(Sender: TObject);	166	procedure ActionLintExecute(Sender: TObject);
167	procedure ActionRunConsoleExecute(Sender: TObject);	167	procedure ActionRunConsoleExecute(Sender: TObject);
168	procedure SynEdit1Change(Sender: TObject);	168	procedure SynEdit1Change(Sender: TObject);
169	procedure Saveas1Click(Sender: TObject);	169	procedure Saveas1Click(Sender: TObject);
170	procedure Save1Click(Sender: TObject);	170	procedure Save1Click(Sender: TObject);
171	procedure BtnSpecialCharsClick(Sender: TObject);	171	procedure BtnSpecialCharsClick(Sender: TObject);
172	procedure WebBrowser1WindowClosing(ASender: TObject;	172	procedure WebBrowser1WindowClosing(ASender: TObject;
173	IsChildWindow: WordBool; var Cancel: WordBool);	173	IsChildWindow: WordBool; var Cancel: WordBool);
174	procedure BtnLightClick(Sender: TObject);	174	procedure BtnLightClick(Sender: TObject);
175	procedure StartUpTimerTimer(Sender: TObject);	175	procedure StartUpTimerTimer(Sender: TObject);
176	procedure FileModTimerTimer(Sender: TObject);	176	procedure FileModTimerTimer(Sender: TObject);
177	procedure GotoPHPdir1Click(Sender: TObject);	177	procedure GotoPHPdir1Click(Sender: TObject);
178	procedure PHPShell1Click(Sender: TObject);	178	procedure PHPShell1Click(Sender: TObject);
-		179	procedure SynEdit1DropFiles(Sender: TObject; X, Y: Integer;
-		180	AFiles: TStrings);
179	private	181	private
180	hMutex: THandle;	182	hMutex: THandle;
181	CurSearchTerm: string;	183	CurSearchTerm: string;
182	HlpPrevPageIndex: integer;	184	HlpPrevPageIndex: integer;
183	SrcRep: TSynEditFindReplace;	185	SrcRep: TSynEditFindReplace;
184	{$IFDEF OnlineHelp}	186	{$IFDEF OnlineHelp}
185	gOnlineHelpWord: string;	187	gOnlineHelpWord: string;
186	{$ENDIF}	188	{$ENDIF}
187	FileModLast: TDateTime;	189	FileModLast: TDateTime;
188	procedure Help;	190	procedure Help;
189	function InputRequestCallback(var data: AnsiString): boolean;	191	function InputRequestCallback(var data: AnsiString): boolean;
190	function OutputNotifyCallback(const data: AnsiString): boolean;	192	function OutputNotifyCallback(const data: AnsiString): boolean;
191	procedure RightTrimAll;	193	procedure RightTrimAll;
192	procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;	-
193	protected	194	protected
194	ChmIndex: TMemIniFile;	195	ChmIndex: TMemIniFile;
195	FScrapFile: string;	196	FScrapFile: string;
196	FSaveAsFilename: string;	197	FSaveAsFilename: string;
197	codeExplorer: TRunCodeExplorer;	198	codeExplorer: TRunCodeExplorer;
198	procedure GotoLineNo(LineNo: integer);	199	procedure GotoLineNo(LineNo: integer);
199	function GetScrapFile: string;	200	function GetScrapFile: string;
200	procedure StartCodeExplorer;	201	procedure StartCodeExplorer;
201	procedure RefreshModifySign;	202	procedure RefreshModifySign;
202	procedure Theme_Light;	203	procedure Theme_Light;
203	procedure Theme_Dark;	204	procedure Theme_Dark;
204	function IsThemeDark: boolean;	205	function IsThemeDark: boolean;
205	function MarkUpLineReference(cont: string): string;	206	function MarkUpLineReference(cont: string): string;
206	procedure SaveToFile(filename: string);	207	procedure SaveToFile(filename: string);
207	end;	208	end;
208		209
209	var	210	var
210	Form1: TForm1;	211	Form1: TForm1;
211		212
212	implementation	213	implementation
213		214
214	{$R *.dfm}	215	{$R *.dfm}
215		216
216	{$R Cursors.res}	217	{$R Cursors.res}
217		218
218	uses	219	uses
219	Functions, StrUtils, WebBrowserUtils, FastPHPUtils, Math, ShellAPI, RichEdit,	220	Functions, StrUtils, WebBrowserUtils, FastPHPUtils, Math, ShellAPI, RichEdit,
220	FastPHPTreeView, ImageListEx, FastPHPConfig;	221	FastPHPTreeView, ImageListEx, FastPHPConfig;
221		222
222	const	223	const
223	crMouseGutter = 1;	224	crMouseGutter = 1;
224		225
225	procedure TForm1.RefreshModifySign;	226	procedure TForm1.RefreshModifySign;
226	var	227	var
227	tmp: string;	228	tmp: string;
228	begin	229	begin
229	tmp := Caption;	230	tmp := Caption;
230		231
231	tmp := StringReplace(tmp, '*', '', [rfReplaceAll]);	232	tmp := StringReplace(tmp, '*', '', [rfReplaceAll]);
232	if SynEdit1.Modified then tmp := tmp + '*';	233	if SynEdit1.Modified then tmp := tmp + '*';
233		234
234	if Caption <> tmp then Caption := tmp;	235	if Caption <> tmp then Caption := tmp;
235	end;	236	end;
236		237
237	procedure TForm1.ActionFindNextExecute(Sender: TObject);	238	procedure TForm1.ActionFindNextExecute(Sender: TObject);
238	begin	239	begin
239	SrcRep.FindNext;	240	SrcRep.FindNext;
240	end;	241	end;
241		242
242	procedure TForm1.ActionFindPrevExecute(Sender: TObject);	243	procedure TForm1.ActionFindPrevExecute(Sender: TObject);
243	begin	244	begin
244	SrcRep.FindPrev;	245	SrcRep.FindPrev;
245	end;	246	end;
246		247
247	procedure TForm1.ActionGotoExecute(Sender: TObject);	248	procedure TForm1.ActionGotoExecute(Sender: TObject);
248	var	249	var
249	val: string;	250	val: string;
250	lineno: integer;	251	lineno: integer;
251	begin	252	begin
252	// TODO: VK_LMENU does not work! only works with AltGr but not Alt	253	// TODO: VK_LMENU does not work! only works with AltGr but not Alt
253	// http://stackoverflow.com/questions/16828250/delphi-xe2-how-to-prevent-the-alt-key-stealing-focus ?	254	// http://stackoverflow.com/questions/16828250/delphi-xe2-how-to-prevent-the-alt-key-stealing-focus ?
254		255
255	InputQuery('Go to', 'Line number:', val);	256	InputQuery('Go to', 'Line number:', val);
256	if not TryStrToInt(val, lineno) then	257	if not TryStrToInt(val, lineno) then
257	begin	258	begin
258	if SynEdit1.CanFocus then SynEdit1.SetFocus;	259	if SynEdit1.CanFocus then SynEdit1.SetFocus;
259	exit;	260	exit;
260	end;	261	end;
261	GotoLineNo(lineno);	262	GotoLineNo(lineno);
262	end;	263	end;
263		264
264	procedure TForm1.ActionHelpExecute(Sender: TObject);	265	procedure TForm1.ActionHelpExecute(Sender: TObject);
265	begin	266	begin
266	Help;	267	Help;
267	if PageControl2.ActivePage = HelpTabsheet then	268	if PageControl2.ActivePage = HelpTabsheet then
268	WebBrowser2.SetFocus	269	WebBrowser2.SetFocus
269	else if PageControl2.ActivePage = CodeTabsheet then	270	else if PageControl2.ActivePage = CodeTabsheet then
270	SynEdit1.SetFocus;	271	SynEdit1.SetFocus;
271	end;	272	end;
272		273
273	procedure TForm1.ActionLintExecute(Sender: TObject);	274	procedure TForm1.ActionLintExecute(Sender: TObject);
274	begin	275	begin
275	Run(Sender);	276	Run(Sender);
276	SynEdit1.SetFocus;	277	SynEdit1.SetFocus;
277	end;	278	end;
278		279
279	procedure TForm1.ActionOpenExecute(Sender: TObject);	280	procedure TForm1.ActionOpenExecute(Sender: TObject);
280	begin	281	begin
281	If OpenDialog3.Execute then	282	If OpenDialog3.Execute then
282	begin	283	begin
283	ShellExecute(0, 'open', PChar(ParamStr(0)), PChar('"' + OpenDialog3.FileName + '"'), '', SW_NORMAL);	284	ShellExecute(0, 'open', PChar(ParamStr(0)), PChar('"' + OpenDialog3.FileName + '"'), '', SW_NORMAL);
284	end;	285	end;
285	end;	286	end;
286		287
287	procedure TForm1.ActionReplaceExecute(Sender: TObject);	288	procedure TForm1.ActionReplaceExecute(Sender: TObject);
288	begin	289	begin
289	SrcRep.ReplaceExecute;	290	SrcRep.ReplaceExecute;
290	end;	291	end;
291		292
292	procedure TForm1.ActionRunConsoleExecute(Sender: TObject);	293	procedure TForm1.ActionRunConsoleExecute(Sender: TObject);
293	begin	294	begin
294	RunConsole(Sender);	295	RunConsole(Sender);
295	SynEdit1.SetFocus;	296	SynEdit1.SetFocus;
296	end;	297	end;
297		298
298	procedure TForm1.ActionRunExecute(Sender: TObject);	299	procedure TForm1.ActionRunExecute(Sender: TObject);
299	begin	300	begin
300	Run(Sender);	301	Run(Sender);
301	SynEdit1.SetFocus;	302	SynEdit1.SetFocus;
302	end;	303	end;
303		304
304	procedure TForm1.RightTrimAll;	305	procedure TForm1.RightTrimAll;
305	var	306	var
306	i: integer;	307	i: integer;
307	begin	308	begin
308	for i := 0 to SynEdit1.Lines.Count-1 do	309	for i := 0 to SynEdit1.Lines.Count-1 do
309	begin	310	begin
310	SynEdit1.Lines.Strings[i] := TrimRight(SynEdit1.Lines.Strings[i]);	311	SynEdit1.Lines.Strings[i] := TrimRight(SynEdit1.Lines.Strings[i]);
311	end;	312	end;
312		313
313	(*	314	(*
314	while (SynEdit1.Lines.Count > 0) and (SynEdit1.Lines.Strings[SynEdit1.Lines.Count-1] = '') do	315	while (SynEdit1.Lines.Count > 0) and (SynEdit1.Lines.Strings[SynEdit1.Lines.Count-1] = '') do
315	begin	316	begin
316	SynEdit1.Lines.Delete(SynEdit1.Lines.Count-1);	317	SynEdit1.Lines.Delete(SynEdit1.Lines.Count-1);
317	end;	318	end;
318	if SynEdit1.SelStart > Length(SynEdit1.Text)-1 then	319	if SynEdit1.SelStart > Length(SynEdit1.Text)-1 then
319	begin	320	begin
320	// TODO: This code does not work...	321	// TODO: This code does not work...
321	SynEdit1.SelStart := Length(SynEdit1.Text)-1;	322	SynEdit1.SelStart := Length(SynEdit1.Text)-1;
322	SynEdit1.SelEnd := Length(SynEdit1.Text)-1;	323	SynEdit1.SelEnd := Length(SynEdit1.Text)-1;
323	end;	324	end;
324	*)	325	*)
325	end;	326	end;
326		327
327	procedure TForm1.ActionSaveExecute(Sender: TObject);	328	procedure TForm1.ActionSaveExecute(Sender: TObject);
328	begin	329	begin
329	RightTrimAll;	330	RightTrimAll;
330	SaveToFile(GetScrapFile);	331	SaveToFile(GetScrapFile);
331	SynEdit1.Modified := false;	332	SynEdit1.Modified := false;
332	RefreshModifySign;	333	RefreshModifySign;
333	if SynEdit1.CanFocus then SynEdit1.SetFocus;	334	if SynEdit1.CanFocus then SynEdit1.SetFocus;
334	end;	335	end;
335		336
336	procedure TForm1.ActionSpaceToTabExecute(Sender: TObject);	337	procedure TForm1.ActionSpaceToTabExecute(Sender: TObject);
337		338
338	function SpacesAtBeginning(line: string): integer;	339	function SpacesAtBeginning(line: string): integer;
339	begin	340	begin
340	result := 0;	341	result := 0;
341	if Trim(line) = '' then exit;	342	if Trim(line) = '' then exit;
342	while line[result+1] = ' ' do	343	while line[result+1] = ' ' do
343	begin	344	begin
344	inc(result);	345	inc(result);
345	end;	346	end;
346	end;	347	end;
347		348
348	function GuessIndent(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}): integer;	349	function GuessIndent(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}): integer;
349	function _Check(indent: integer): boolean;	350	function _Check(indent: integer): boolean;
350	var	351	var
351	i: integer;	352	i: integer;
352	begin	353	begin
353	result := true;	354	result := true;
354	for i := 0 to lines.Count-1 do	355	for i := 0 to lines.Count-1 do
355	if SpacesAtBeginning(lines.Strings[i]) mod indent <> 0 then	356	if SpacesAtBeginning(lines.Strings[i]) mod indent <> 0 then
356	begin	357	begin
357	// ShowMessageFmt('Zeile "%s" nicht durch %d teilbar!', [lines.strings[i], indent]);	358	// ShowMessageFmt('Zeile "%s" nicht durch %d teilbar!', [lines.strings[i], indent]);
358	result := false;	359	result := false;
359	exit;	360	exit;
360	end;	361	end;
361	end;	362	end;
362	var	363	var
363	i: integer;	364	i: integer;
364	begin	365	begin
365	for i := 8 downto 2 do	366	for i := 8 downto 2 do
366	begin	367	begin
367	if _Check(i) then	368	if _Check(i) then
368	begin	369	begin
369	result := i;	370	result := i;
370	exit;	371	exit;
371	end;	372	end;
372	end;	373	end;
373	result := -1;	374	result := -1;
374	end;	375	end;
375		376
376	procedure SpaceToTab(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}; indent: integer);	377	procedure SpaceToTab(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}; indent: integer);
377	var	378	var
378	i, spaces: integer;	379	i, spaces: integer;
379	begin	380	begin
380	for i := 0 to lines.Count-1 do	381	for i := 0 to lines.Count-1 do
381	begin	382	begin
382	spaces := SpacesAtBeginning(lines.Strings[i]);	383	spaces := SpacesAtBeginning(lines.Strings[i]);
383	lines.Strings[i] := StringOfChar(#9, spaces div indent) + StringOfChar(' ', spaces mod indent) + Copy(lines.Strings[i], spaces+1, Length(lines.Strings[i])-spaces);	384	lines.Strings[i] := StringOfChar(#9, spaces div indent) + StringOfChar(' ', spaces mod indent) + Copy(lines.Strings[i], spaces+1, Length(lines.Strings[i])-spaces);
384	end;	385	end;
385	end;	386	end;
386		387
387	function SpacesAvailable(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}): boolean;	388	function SpacesAvailable(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}): boolean;
388	var	389	var
389	i, spaces: integer;	390	i, spaces: integer;
390	begin	391	begin
391	for i := 0 to lines.Count-1 do	392	for i := 0 to lines.Count-1 do
392	begin	393	begin
393	spaces := SpacesAtBeginning(lines.Strings[i]);	394	spaces := SpacesAtBeginning(lines.Strings[i]);
394	if spaces > 0 then	395	if spaces > 0 then
395	begin	396	begin
396	result := true;	397	result := true;
397	exit;	398	exit;
398	end;	399	end;
399	end;	400	end;
400	result := false;	401	result := false;
401	exit;	402	exit;
402	end;	403	end;
403		404
404	var	405	var
405	val: string;	406	val: string;
406	ind: integer;	407	ind: integer;
407	resourcestring	408	resourcestring
408	SNoLinesAvailable = 'No lines with spaces at the beginning available';	409	SNoLinesAvailable = 'No lines with spaces at the beginning available';
409	begin	410	begin
410	// TODO: if something is selected, only process the selected part	411	// TODO: if something is selected, only process the selected part
411		412
412	if not SpacesAvailable(SynEdit1.Lines) then	413	if not SpacesAvailable(SynEdit1.Lines) then
413	begin	414	begin
414	MessageDlg(SNoLinesAvailable, mtInformation, [mbOk], 0);	415	MessageDlg(SNoLinesAvailable, mtInformation, [mbOk], 0);
415	exit;	416	exit;
416	end;	417	end;
417		418
418	ind := GuessIndent(SynEdit1.Lines);	419	ind := GuessIndent(SynEdit1.Lines);
419	if ind <> -1 then val := IntToStr(ind);	420	if ind <> -1 then val := IntToStr(ind);
420		421
421	InputQuery('Spaces to tabs', 'Indent:', val); // TODO: handle CANCEL correctly...	422	InputQuery('Spaces to tabs', 'Indent:', val); // TODO: handle CANCEL correctly...
422	if TryStrToInt(Trim(val), ind) then	423	if TryStrToInt(Trim(val), ind) then
423	begin	424	begin
424	if ind = 0 then exit;	425	if ind = 0 then exit;
425	SpaceToTab(SynEdit1.Lines, ind);	426	SpaceToTab(SynEdit1.Lines, ind);
426	end;	427	end;
427		428
428	if SynEdit1.CanFocus then SynEdit1.SetFocus;	429	if SynEdit1.CanFocus then SynEdit1.SetFocus;
429	end;	430	end;
430		431
431	procedure TForm1.ActionESCExecute(Sender: TObject);	432	procedure TForm1.ActionESCExecute(Sender: TObject);
432	begin	433	begin
433	if (HlpPrevPageIndex <> -1) and (PageControl2.ActivePage = HelpTabSheet) and	434	if (HlpPrevPageIndex <> -1) and (PageControl2.ActivePage = HelpTabSheet) and
434	(HelpTabsheet.TabVisible) then	435	(HelpTabsheet.TabVisible) then
435	begin	436	begin
436	PageControl2.ActivePageIndex := HlpPrevPageIndex;	437	PageControl2.ActivePageIndex := HlpPrevPageIndex;
437	HelpTabsheet.TabVisible := false;	438	HelpTabsheet.TabVisible := false;
438	end;	439	end;
439		440
440	// Dirty hack...	441	// Dirty hack...
441	SrcRep.CloseDialogs;	442	SrcRep.CloseDialogs;
442	end;	443	end;
443		444
444	procedure TForm1.ActionFindExecute(Sender: TObject);	445	procedure TForm1.ActionFindExecute(Sender: TObject);
445	begin	446	begin
446	SrcRep.FindExecute;	447	SrcRep.FindExecute;
447	end;	448	end;
448		449
449	var	450	var
450	firstTimeBrowserLoad: boolean = true;	451	firstTimeBrowserLoad: boolean = true;
451	procedure TForm1.Run(Sender: TObject);	452	procedure TForm1.Run(Sender: TObject);
452	var	453	var
453	bakTS: TTabSheet;	454	bakTS: TTabSheet;
454	//ss: TStringStream;	455	//ss: TStringStream;
455	//bakPos: Int64;	456	//bakPos: Int64;
456	begin	457	begin
457	memo2.Lines.Text := '';	458	memo2.Lines.Text := '';
458		459
459	if firstTimeBrowserLoad then	460	if firstTimeBrowserLoad then
460	begin	461	begin
461	bakTS := PageControl1.ActivePage;	462	bakTS := PageControl1.ActivePage;
462	try	463	try
463	PageControl1.ActivePage := HtmlTabSheet; // Required for the first time, otherwise, WebBrowser1.Clear will hang	464	PageControl1.ActivePage := HtmlTabSheet; // Required for the first time, otherwise, WebBrowser1.Clear will hang
464	Webbrowser1.Clear;	465	Webbrowser1.Clear;
465	finally	466	finally
466	PageControl1.ActivePage := bakTS;	467	PageControl1.ActivePage := bakTS;
467	end;	468	end;
468	firstTimeBrowserLoad := false;	469	firstTimeBrowserLoad := false;
469	end	470	end
470	else	471	else
471	Webbrowser1.Clear;	472	Webbrowser1.Clear;
472		473
473	Screen.Cursor := crHourGlass;	474	Screen.Cursor := crHourGlass;
474	Application.ProcessMessages;	475	Application.ProcessMessages;
475		476
476	try	477	try
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.	478	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.
478		479
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 !!!!!!!!	480	// 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 !!!!!!!!
480	// TODO 70422 * <fastphp> wenn ein script hängt, soll man es abwürgen dürfen!!!!!!	481	// TODO 70422 * <fastphp> wenn ein script hängt, soll man es abwürgen dürfen!!!!!!
481	memo2.Lines.Text := RunPHPScript(GetScrapFile, Sender=ActionLint, False);	482	memo2.Lines.Text := RunPHPScript(GetScrapFile, Sender=ActionLint, False);
482		483
483	{$REGION 'Show in Web Browser'}	484	{$REGION 'Show in Web Browser'}
484	Webbrowser1.LoadHTML(MarkUpLineReference(memo2.Lines.Text), GetScrapFile);	485	Webbrowser1.LoadHTML(MarkUpLineReference(memo2.Lines.Text), GetScrapFile);
485		486
486	// Alternatively:	487	// Alternatively:
487	(*	488	(*
488	ss := TstringStream.Create;	489	ss := TstringStream.Create;
489	ss.WriteString(MarkUpLineReference(memo2.Lines.Text));	490	ss.WriteString(MarkUpLineReference(memo2.Lines.Text));
490	ss.Position := 0;	491	ss.Position := 0;
491	Webbrowser1.LoadStream(ss, GetScrapFile);	492	Webbrowser1.LoadStream(ss, GetScrapFile);
492	Webbrowser1.Wait;	493	Webbrowser1.Wait;
493	ss.Free;	494	ss.Free;
494	*)	495	*)
495	{$ENDREGION}	496	{$ENDREGION}
496		497
497	if IsTextHTML(memo2.lines.text) then	498	if IsTextHTML(memo2.lines.text) then
498	PageControl1.ActivePage := HtmlTabSheet	499	PageControl1.ActivePage := HtmlTabSheet

Subversion Repositories fastphp

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