Subversion Repositories fastphp

unit EditorMain;

(*

  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: localize

// TODO: wieso geht copy paste im twebbrowser nicht???

// Wieso dauert webbrowser1 erste kompilierung so lange???

// TODO: wieso kommt syntax fehler zweimal? einmal stderr einmal stdout?

// TODO: Browser titlebar (link preview)

// Future ideas

// - ToDo list

// - 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?

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, OleCtrls, ComCtrls, ExtCtrls, ToolWin, IniFiles,

  SynEditHighlighter, SynHighlighterPHP, SynEdit, SHDocVw_TLB, FindReplace,

  System.Actions, Vcl.ActnList;

type

  TForm1 = class(TForm)

    PageControl1: TPageControl;

    PlaintextTabSheet: TTabSheet;

    HtmlTabSheet: TTabSheet;

    Memo2: TMemo;

    WebBrowser1: TWebBrowser;

    Splitter1: TSplitter;

    PageControl2: TPageControl;

    TabSheet3: 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;

    procedure Run(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);

    procedure WebBrowser1BeforeNavigate2(ASender: TObject;

      const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,

      Headers: 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);

  private

    CurSearchTerm: string;

    HlpPrevPageIndex: integer;

    SrcRep: TFindReplace;

    procedure Help;

    function MarkUpLineReference(cont: string): string;

  protected

    ChmIndex: TMemIniFile;

    procedure GotoLineNo(LineNo:integer);

    function GetScrapFile: string;

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

uses

  Functions, StrUtils, WebBrowserUtils, FastPHPUtils, Math, ShellAPI;

// TODO: FindPrev ?

procedure TForm1.ActionFindNextExecute(Sender: TObject);

begin

  SrcRep.FindNext;

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 = TabSheet3{Scrap} then

    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.ActionRunExecute(Sender: TObject);

begin

  Run(Sender);

  SynEdit1.SetFocus;

end;

procedure TForm1.ActionSaveExecute(Sender: TObject);

begin

  SynEdit1.Lines.SaveToFile(GetScrapFile);

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._FindDialog.CloseDialog;

  SrcRep._ReplaceDialog.CloseDialog;

end;

procedure TForm1.ActionFindExecute(Sender: TObject);

begin

  SrcRep.FindExecute;

end;

procedure TForm1.Run(Sender: TObject);

begin

  memo2.Lines.Text := '';

  Webbrowser1.Clear;

  Screen.Cursor := crHourGlass;

  Application.ProcessMessages;

  try

    SynEdit1.Lines.SaveToFile(GetScrapFile);

    memo2.Lines.Text := RunPHPScript(GetScrapFile);

    Webbrowser1.LoadHTML(MarkUpLineReference(memo2.Lines.Text), GetScrapFile);

    if IsTextHTML(memo2.lines.text) then

      PageControl1.ActivePage := HtmlTabSheet

    else

      PageControl1.ActivePage := PlaintextTabSheet;

  finally

    Screen.Cursor := crDefault;

  end;

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);

  end;

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;

  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.WebBrowser1BeforeNavigate2(ASender: TObject;

  const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,

  Headers: 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)'}

  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!

    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(GetDosOutput('"'+GetPHPExe+'" "'+myURL+'"', ExtractFileDir(Application.ExeName)), myUrl);

      Cancel := true;

    end;

  end;

  {$ENDREGION}

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  FastPHPConfig.WriteInteger('User', '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) <> '' 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

        SynEdit1.Lines.SaveToFile(GetScrapFile);

        CanClose := true;

      end;

    end

    else

    begin

      SynEdit1.Lines.SaveToFile(GetScrapFile);

      CanClose := true;

    end;

  end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

  HlpPrevPageIndex := -1;

  CurSearchTerm := '';

  Caption := Caption + ' - ' + GetScrapFile;

  SrcRep := TFindReplace.Create(self);

  SrcRep.Editor := SynEdit1;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

  if Assigned(ChmIndex) then

  begin

    FreeAndNil(ChmIndex);

  end;

  FreeAndNil(SrcRep);

end;

procedure TForm1.FormShow(Sender: TObject);

var

  ScrapFile: string;

begin

  ScrapFile := GetScrapFile;

  if ScrapFile = '' then

  begin

    Application.Terminate; // Close;

    exit;

  end;

  if FileExists(ScrapFile) then

    SynEdit1.Lines.LoadFromFile(ScrapFile)

  else

    SynEdit1.Lines.Clear;

  PageControl1.ActivePage := PlaintextTabSheet;

  PageControl2.ActivePageIndex := 0; // Scraps

  HelpTabsheet.TabVisible := false;

  SynEdit1.Font.Size := FastPHPConfig.ReadInteger('User', 'FontSize', SynEdit1.Font.Size);

  SynEdit1.SetFocus;

end;

function TForm1.GetScrapFile: string;

begin

  if ParamStr(1) <> '' then

    result := ParamStr(1)

  else

    result := FastPHPConfig.ReadString('Paths', 'ScrapFile', '');

  if not FileExists(result) then

  begin

    if not OpenDialog3.Execute then

    begin

      result := '';

      exit;

    end

    else

      result := OpenDialog3.FileName;

    if not DirectoryExists(ExtractFilePath(result)) then

    begin

      ShowMessage('Path does not exist!');

      result := '';

      exit;

    end;

    SynEdit1.Lines.Clear;

    SynEdit1.Lines.SaveToFile(result);

    FastPHPConfig.WriteString('Paths', 'ScrapFile', result);

  end;

end;

procedure TForm1.Help;

var

  IndexFile, chmFile, w, url: string;

  internalHtmlFile: string;

begin

  if not Assigned(ChmIndex) then

  begin

    IndexFile := FastPHPConfig.ReadString('Paths', '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 := FastPHPConfig.ReadString('Paths', '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

          ShowMessage('The CHM file is not a valid PHP documentation. Cannot use help.');

          exit;

        end;

      finally

        Screen.Cursor := crDefault;

        Panel1.Visible := false;

      end;

      if not FileExists(IndexFile) then

      begin

        ShowMessage('Unknown error. Cannot use help.');

        exit;

      end;

    end;

    FastPHPConfig.WriteString('Paths', 'HelpIndex', IndexFile);

    FastPHPConfig.UpdateFile;

    ChmIndex := TMemIniFile.Create(IndexFile);

  end;

  w := GetWordUnderCaret(SynEdit1);

  if w = '' then exit;

  if CharInSet(w[1], ['0'..'9']) then exit;

  w := StringReplace(w, '_', '-', [rfReplaceAll]);

  w := LowerCase(w);

  CurSearchTerm := w;

  internalHtmlFile := ChmIndex.ReadString('_HelpWords_', CurSearchTerm, '');

  if internalHtmlFile = '' then

  begin

    HelpTabsheet.TabVisible := false;

    HlpPrevPageIndex := -1;

    ShowMessage('No help for "'+CurSearchTerm+'" available');

    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

    if not CharInSet(line[i], [' ', #9]) then

    begin

      SynEdit1.CaretX := i-1;

      break;

    end;

  end;

  PageControl2.ActivePage := TabSheet3{Scrap};

  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;

  p, lineno: integer;

begin

  line := memo2.Lines.Strings[Memo2.CaretPos.Y];

  p := Pos(' on line ', line);

  if p = 0 then exit;

  line := copy(line, p+length(' on line '), 99);

  if not TryStrToInt(line, lineno) then exit;

  GotoLineNo(lineno);

end;

function TForm1.MarkUpLineReference(cont: string): string;

var

  p, a, b: integer;

  num: integer;

  insert_a, insert_b: string;

begin

  // TODO: make it more specific to PHP error messages. "on line" is too broad.

  p := Pos(' on line ', cont);

  while p >= 1 do

  begin

    a := p+1;

    b := p+length(' on line ');

    num := 0;

    while CharInSet(cont[b], ['0'..'9']) do

    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(' on line ', cont, p+1);

  end;

  result := cont;

end;

end.