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

Subversion Repositories fastphp

fastphp/trunk/EditorMain.pas – Rev 83 → 85