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: 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)
// TODO: todo liste
 
// Future ideas
// - code explorer / 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)?
 
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_TLB, FindReplace,
  System.Actions, Vcl.ActnList, System.UITypes, SynEditMiscClasses,
  SynEditSearch, RunPHP;
 
{.$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;
    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);
    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);
  private
    CurSearchTerm: string;
    HlpPrevPageIndex: integer;
    SrcRep: TSynEditFindReplace;
    {$IFDEF OnlineHelp}
    gOnlineHelpWord: string;
    {$ENDIF}
    procedure Help;
    function MarkUpLineReference(cont: string): string;
    function InputRequestCallback: string;
    procedure OutputNotifyCallback(const data: string);
  protected
    ChmIndex: TMemIniFile;
    FScrapFile: string;
    codeExplorer: TRunCodeExplorer;
    procedure GotoLineNo(LineNo: integer);
    function GetScrapFile: string;
    procedure StartCodeExplorer;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{$R Cursors.res}
 
uses
  Functions, StrUtils, WebBrowserUtils, FastPHPUtils, Math, ShellAPI, RichEdit,
  FastPHPTreeView;
 
const
  crMouseGutter = 1;
 
// TODO: FindPrev ?
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.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);
  SynEdit1.Modified := false;
end;
 
procedure TForm1.ActionSpaceToTabExecute(Sender: TObject);
 
    function SpacesAtBeginning(line: string): integer;
    begin
      if line.Trim = '' then exit(0);
      result := 0;
      while line[result+1] = ' ' do
      begin
        inc(result);
      end;
    end;
 
    function GuessIndent(lines: TStrings): 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]);
            exit(false);
          end;
      end;
    var
      i: integer;
    begin
      for i := 8 downto 2 do
      begin
        if _Check(i) then exit(i);
      end;
      result := -1;
    end;
 
    procedure SpaceToTab(lines: TStrings; 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: TStrings): boolean;
    var
      i, spaces: integer;
    begin
      for i := 0 to lines.Count-1 do
      begin
        spaces := SpacesAtBeginning(lines.Strings[i]);
        if spaces > 0 then exit(true);
      end;
      exit(false);
    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
    ShowMessage(SNoLinesAvailable);
    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(val.Trim, 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;
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
    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.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.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.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;
begin
  tn := TTreeView(Sender).Selected;
  if tn = nil then exit;
  GotoLineNo(Integer(tn.Data));
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(RunPHPScript(myURL), 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 := TSynEditFindReplace.Create(self);
  SrcRep.Editor := SynEdit1;
  SynEdit1.Gutter.Gradient := HighColorWindows;
 
  Screen.Cursors[crMouseGutter] := LoadCursor(hInstance, 'MOUSEGUTTER');
  SynEdit1.Gutter.Cursor := crMouseGutter;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(ChmIndex) then
  begin
    FreeAndNil(ChmIndex);
  end;
  FreeAndNil(SrcRep);
 
  if Assigned(codeExplorer) then
  begin
    codeExplorer.Terminate;
    codeExplorer.WaitFor;
    FreeAndNil(codeExplorer);
  end;
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.ActivePage := CodeTabsheet;
  HelpTabsheet.TabVisible := false;
 
  SynEdit1.Font.Size := FastPHPConfig.ReadInteger('User', 'FontSize', SynEdit1.Font.Size);
  SynEdit1.SetFocus;
 
  DoubleBuffered := true;
  StartCodeExplorer;
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.Start;
end;
 
function TForm1.GetScrapFile: string;
begin
  if FScrapFile <> '' then exit(FScrapFile);
 
  if ParamStr(1) <> '' then
    result := ParamStr(1)
  else
    result := FastPHPConfig.ReadString('Paths', 'ScrapFile', '');
  if not FileExists(result) then
  begin
    repeat
      if not OpenDialog3.Execute then
      begin
        Application.Terminate;
        exit('');
      end;
 
      if not DirectoryExists(ExtractFilePath(OpenDialog3.FileName)) then
      begin
        ShowMessage('Path does not exist! Please try again.');
      end
      else
      begin
        result := OpenDialog3.FileName;
      end;
    until result <> '';
 
    SynEdit1.Lines.Clear;
    SynEdit1.Lines.SaveToFile(result);
 
    FastPHPConfig.WriteString('Paths', 'ScrapFile', result);
    FScrapFile := result;
  end;
end;
 
procedure TForm1.Help;
var
  IndexFile, chmFile, w, OriginalWord, 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;
 
  Originalword := w;
//  w := StringReplace(w, '_', '-', [rfReplaceAll]);
  w := LowerCase(w);
  CurSearchTerm := w;
 
  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
    if not CharInSet(line[i], [' ', #9]) then
    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(toFind.ToLower, line.ToLower);
    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(toFind.ToLower, cont.ToLower);
    while p >= 1 do
    begin
      a := p;
      b := p + length(toFind);
      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(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: string;
begin
  result := SynEdit1.Text;
end;
 
procedure TForm1.OutputNotifyCallback(const data: string);
begin
  TreeView1.FillWithFastPHPData(data);
end;
 
end.
 

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

Subversion Repositories fastphp

fastphp/trunk/EditorMain.pas – Rev 29 → 30