Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/fastphp/trunk/EditorMain.pas
Revision: 79
Committed: Mon Aug 24 08:22:10 2020 UTC (11 months ago) by daniel-marschall
Content type: text/x-pascal
File size: 43438 byte(s)
Log Message:
Made file saving (line ending etc.) more intelligent, e.g. if Shebang is detected, Linux line-endings will be used.

File Contents

# Content
1 unit EditorMain;
2
3 {$Include 'FastPHP.inc'}
4
5 (*
6 This program requires
7 - Microsoft Internet Controls (TWebBrowser)
8 If you are using Delphi 10.1 Starter Edition, please import the ActiveX TLB
9 "Microsoft Internet Controls"
10 - SynEdit
11 You can obtain SynEdit via Embarcadero GetIt
12 *)
13
14 // TODO: if a scrapfile is already open, create a new scrap file (scrap2.php)
15 // TODO: localize
16 // TODO: wieso geht copy paste im twebbrowser nicht???
17 // TODO: Wieso dauert webbrowser1 erste kompilierung so lange???
18 // TODO: wieso kommt syntax fehler zweimal? einmal stderr einmal stdout?
19 // TODO: Browser titlebar (link preview)
20 // TODO: "jump to next/prev todo" buttons/shortcuts
21 // TODO: "increase/decrease indent" buttons/shortcuts
22
23 // Small things:
24 // - The scroll bars of SynEdit are not affected by the dark theme
25
26 // Future ideas
27 // - code insight
28 // - verschiedene php versionen?
29 // - webbrowser1 nur laden, wenn man den tab anwählt?
30 // - doppelklick auf tab soll diesen schließen
31 // - Onlinehelp (www) aufrufen
32 // - Let all colors be adjustable
33 // - code in bildschirmmitte (horizontal)?
34 // - search in files of a directory
35 // - multi tab?
36 // - DDE (drag n drop)
37 // - check if file has been modified in another application
38
39 interface
40
41 uses
42 // TODO: "{$IFDEF USE_SHDOCVW_TLB}_TLB{$ENDIF}" does not work with Delphi 10.2
43 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
44 Dialogs, StdCtrls, OleCtrls, ComCtrls, ExtCtrls, ToolWin, IniFiles,
45 SynEditHighlighter, SynHighlighterPHP, SynEdit, ShDocVw_TLB, FindReplace,
46 ActnList, SynEditMiscClasses, SynEditSearch, RunPHP, ImgList, SynUnicode,
47 System.ImageList, System.Actions, Vcl.Menus, SHDocVw, Vcl.Themes;
48
49 {.$DEFINE OnlineHelp}
50
51 type
52 TForm1 = class(TForm)
53 PageControl1: TPageControl;
54 PlaintextTabSheet: TTabSheet;
55 HtmlTabSheet: TTabSheet;
56 Memo2: TMemo;
57 WebBrowser1: TWebBrowser;
58 Splitter1: TSplitter;
59 PageControl2: TPageControl;
60 CodeTabsheet: TTabSheet;
61 HelpTabsheet: TTabSheet;
62 WebBrowser2: TWebBrowser;
63 OpenDialog1: TOpenDialog;
64 Panel1: TPanel;
65 OpenDialog3: TOpenDialog;
66 SynEdit1: TSynEdit;
67 SynPHPSyn1: TSynPHPSyn;
68 Panel2: TPanel;
69 SynEditFocusTimer: TTimer;
70 Button1: TButton;
71 Button2: TButton;
72 Button3: TButton;
73 Button4: TButton;
74 Button5: TButton;
75 Button6: TButton;
76 ActionList: TActionList;
77 ActionFind: TAction;
78 ActionReplace: TAction;
79 ActionFindNext: TAction;
80 ActionGoto: TAction;
81 ActionSave: TAction;
82 ActionHelp: TAction;
83 ActionRun: TAction;
84 ActionESC: TAction;
85 Button7: TButton;
86 ActionOpen: TAction;
87 Button8: TButton;
88 Button9: TButton;
89 ActionFindPrev: TAction;
90 Timer1: TTimer;
91 ActionSpaceToTab: TAction;
92 Button11: TButton;
93 SynEditSearch1: TSynEditSearch;
94 TreeView1: TTreeView;
95 Splitter2: TSplitter;
96 btnLint: TButton;
97 ActionLint: TAction;
98 ImageList1: TImageList;
99 RunPopup: TPopupMenu;
100 OpeninIDE1: TMenuItem;
101 ActionRunConsole: TAction;
102 Runinconsole1: TMenuItem;
103 SavePopup: TPopupMenu;
104 Saveas1: TMenuItem;
105 Save1: TMenuItem;
106 SaveDialog1: TSaveDialog;
107 BtnSpecialChars: TImage;
108 BtnSpecialCharsOff: TImage;
109 BtnSpecialCharsOn: TImage;
110 BtnLightOn: TImage;
111 BtnLightOff: TImage;
112 BtnLight: TImage;
113 StartUpTimer: TTimer;
114 procedure Run(Sender: TObject);
115 procedure RunConsole(Sender: TObject);
116 procedure FormShow(Sender: TObject);
117 procedure FormCreate(Sender: TObject);
118 procedure FormDestroy(Sender: TObject);
119 procedure FormClose(Sender: TObject; var Action: TCloseAction);
120 procedure PageControl2Changing(Sender: TObject; var AllowChange: Boolean);
121 procedure Memo2DblClick(Sender: TObject);
122 (*
123 {$IFDEF USE_SHDOCVW_TLB}
124 *)
125 procedure WebBrowser1BeforeNavigate2(ASender: TObject;
126 const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
127 Headers: OleVariant; var Cancel: WordBool);
128 (*
129 {$ELSE}
130 procedure WebBrowser1BeforeNavigate2(ASender: TObject;
131 const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
132 Headers: OleVariant; var Cancel: WordBool);
133 {$ENDIF}
134 *)
135 procedure BeforeNavigate(const URL: OleVariant; var Cancel: WordBool);
136 procedure SynEditFocusTimerTimer(Sender: TObject);
137 procedure ActionFindExecute(Sender: TObject);
138 procedure ActionReplaceExecute(Sender: TObject);
139 procedure ActionFindNextExecute(Sender: TObject);
140 procedure ActionGotoExecute(Sender: TObject);
141 procedure ActionSaveExecute(Sender: TObject);
142 procedure ActionHelpExecute(Sender: TObject);
143 procedure ActionRunExecute(Sender: TObject);
144 procedure ActionESCExecute(Sender: TObject);
145 procedure SynEdit1MouseWheelDown(Sender: TObject; Shift: TShiftState;
146 MousePos: TPoint; var Handled: Boolean);
147 procedure SynEdit1MouseWheelUp(Sender: TObject; Shift: TShiftState;
148 MousePos: TPoint; var Handled: Boolean);
149 procedure ActionOpenExecute(Sender: TObject);
150 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
151 procedure Memo2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
152 procedure ActionFindPrevExecute(Sender: TObject);
153 procedure SynEdit1MouseCursor(Sender: TObject;
154 const aLineCharPos: TBufferCoord; var aCursor: TCursor);
155 procedure Timer1Timer(Sender: TObject);
156 procedure ActionSpaceToTabExecute(Sender: TObject);
157 procedure TreeView1DblClick(Sender: TObject);
158 procedure SynEdit1GutterClick(Sender: TObject; Button: TMouseButton; X, Y,
159 Line: Integer; Mark: TSynEditMark);
160 procedure SynEdit1PaintTransient(Sender: TObject; Canvas: TCanvas;
161 TransientType: TTransientType);
162 procedure ActionLintExecute(Sender: TObject);
163 procedure ActionRunConsoleExecute(Sender: TObject);
164 procedure SynEdit1Change(Sender: TObject);
165 procedure Saveas1Click(Sender: TObject);
166 procedure Save1Click(Sender: TObject);
167 procedure BtnSpecialCharsClick(Sender: TObject);
168 procedure WebBrowser1WindowClosing(ASender: TObject;
169 IsChildWindow: WordBool; var Cancel: WordBool);
170 procedure BtnLightClick(Sender: TObject);
171 procedure StartUpTimerTimer(Sender: TObject);
172 private
173 hMutex: THandle;
174 CurSearchTerm: string;
175 HlpPrevPageIndex: integer;
176 SrcRep: TSynEditFindReplace;
177 {$IFDEF OnlineHelp}
178 gOnlineHelpWord: string;
179 {$ENDIF}
180 procedure Help;
181 function InputRequestCallback(var data: AnsiString): boolean;
182 function OutputNotifyCallback(const data: AnsiString): boolean;
183 procedure RightTrimAll;
184 protected
185 ChmIndex: TMemIniFile;
186 FScrapFile: string;
187 FSaveAsFilename: string;
188 codeExplorer: TRunCodeExplorer;
189 procedure GotoLineNo(LineNo: integer);
190 function GetScrapFile: string;
191 procedure StartCodeExplorer;
192 procedure RefreshModifySign;
193 procedure Theme_Light;
194 procedure Theme_Dark;
195 function IsThemeDark: boolean;
196 function MarkUpLineReference(cont: string): string;
197 procedure SaveToFile(filename: string);
198 end;
199
200 var
201 Form1: TForm1;
202
203 implementation
204
205 {$R *.dfm}
206
207 {$R Cursors.res}
208
209 uses
210 Functions, StrUtils, WebBrowserUtils, FastPHPUtils, Math, ShellAPI, RichEdit,
211 FastPHPTreeView, ImageListEx, FastPHPConfig;
212
213 const
214 crMouseGutter = 1;
215
216 procedure TForm1.RefreshModifySign;
217 var
218 tmp: string;
219 begin
220 tmp := Caption;
221
222 tmp := StringReplace(tmp, '*', '', [rfReplaceAll]);
223 if SynEdit1.Modified then tmp := tmp + '*';
224
225 if Caption <> tmp then Caption := tmp;
226 end;
227
228 procedure TForm1.ActionFindNextExecute(Sender: TObject);
229 begin
230 SrcRep.FindNext;
231 end;
232
233 procedure TForm1.ActionFindPrevExecute(Sender: TObject);
234 begin
235 SrcRep.FindPrev;
236 end;
237
238 procedure TForm1.ActionGotoExecute(Sender: TObject);
239 var
240 val: string;
241 lineno: integer;
242 begin
243 // TODO: VK_LMENU does not work! only works with AltGr but not Alt
244 // http://stackoverflow.com/questions/16828250/delphi-xe2-how-to-prevent-the-alt-key-stealing-focus ?
245
246 InputQuery('Go to', 'Line number:', val);
247 if not TryStrToInt(val, lineno) then
248 begin
249 if SynEdit1.CanFocus then SynEdit1.SetFocus;
250 exit;
251 end;
252 GotoLineNo(lineno);
253 end;
254
255 procedure TForm1.ActionHelpExecute(Sender: TObject);
256 begin
257 Help;
258 if PageControl2.ActivePage = HelpTabsheet then
259 WebBrowser2.SetFocus
260 else if PageControl2.ActivePage = CodeTabsheet then
261 SynEdit1.SetFocus;
262 end;
263
264 procedure TForm1.ActionLintExecute(Sender: TObject);
265 begin
266 Run(Sender);
267 SynEdit1.SetFocus;
268 end;
269
270 procedure TForm1.ActionOpenExecute(Sender: TObject);
271 begin
272 If OpenDialog3.Execute then
273 begin
274 ShellExecute(0, 'open', PChar(ParamStr(0)), PChar('"' + OpenDialog3.FileName + '"'), '', SW_NORMAL);
275 end;
276 end;
277
278 procedure TForm1.ActionReplaceExecute(Sender: TObject);
279 begin
280 SrcRep.ReplaceExecute;
281 end;
282
283 procedure TForm1.ActionRunConsoleExecute(Sender: TObject);
284 begin
285 RunConsole(Sender);
286 SynEdit1.SetFocus;
287 end;
288
289 procedure TForm1.ActionRunExecute(Sender: TObject);
290 begin
291 Run(Sender);
292 SynEdit1.SetFocus;
293 end;
294
295 procedure TForm1.RightTrimAll;
296 var
297 i: integer;
298 begin
299 for i := 0 to SynEdit1.Lines.Count-1 do
300 begin
301 SynEdit1.Lines.Strings[i] := TrimRight(SynEdit1.Lines.Strings[i]);
302 end;
303
304 (*
305 while (SynEdit1.Lines.Count > 0) and (SynEdit1.Lines.Strings[SynEdit1.Lines.Count-1] = '') do
306 begin
307 SynEdit1.Lines.Delete(SynEdit1.Lines.Count-1);
308 end;
309 if SynEdit1.SelStart > Length(SynEdit1.Text)-1 then
310 begin
311 // TODO: This code does not work...
312 SynEdit1.SelStart := Length(SynEdit1.Text)-1;
313 SynEdit1.SelEnd := Length(SynEdit1.Text)-1;
314 end;
315 *)
316 end;
317
318 procedure TForm1.ActionSaveExecute(Sender: TObject);
319 begin
320 RightTrimAll;
321 SaveToFile(GetScrapFile);
322 SynEdit1.Modified := false;
323 RefreshModifySign;
324 if SynEdit1.CanFocus then SynEdit1.SetFocus;
325 end;
326
327 procedure TForm1.ActionSpaceToTabExecute(Sender: TObject);
328
329 function SpacesAtBeginning(line: string): integer;
330 begin
331 result := 0;
332 if Trim(line) = '' then exit;
333 while line[result+1] = ' ' do
334 begin
335 inc(result);
336 end;
337 end;
338
339 function GuessIndent(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}): integer;
340 function _Check(indent: integer): boolean;
341 var
342 i: integer;
343 begin
344 result := true;
345 for i := 0 to lines.Count-1 do
346 if SpacesAtBeginning(lines.Strings[i]) mod indent <> 0 then
347 begin
348 // ShowMessageFmt('Zeile "%s" nicht durch %d teilbar!', [lines.strings[i], indent]);
349 result := false;
350 exit;
351 end;
352 end;
353 var
354 i: integer;
355 begin
356 for i := 8 downto 2 do
357 begin
358 if _Check(i) then
359 begin
360 result := i;
361 exit;
362 end;
363 end;
364 result := -1;
365 end;
366
367 procedure SpaceToTab(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}; indent: integer);
368 var
369 i, spaces: integer;
370 begin
371 for i := 0 to lines.Count-1 do
372 begin
373 spaces := SpacesAtBeginning(lines.Strings[i]);
374 lines.Strings[i] := StringOfChar(#9, spaces div indent) + StringOfChar(' ', spaces mod indent) + Copy(lines.Strings[i], spaces+1, Length(lines.Strings[i])-spaces);
375 end;
376 end;
377
378 function SpacesAvailable(lines: {$IFDEF UNICODE}TStrings{$ELSE}TUnicodeStrings{$ENDIF}): boolean;
379 var
380 i, spaces: integer;
381 begin
382 for i := 0 to lines.Count-1 do
383 begin
384 spaces := SpacesAtBeginning(lines.Strings[i]);
385 if spaces > 0 then
386 begin
387 result := true;
388 exit;
389 end;
390 end;
391 result := false;
392 exit;
393 end;
394
395 var
396 val: string;
397 ind: integer;
398 resourcestring
399 SNoLinesAvailable = 'No lines with spaces at the beginning available';
400 begin
401 // TODO: if something is selected, only process the selected part
402
403 if not SpacesAvailable(SynEdit1.Lines) then
404 begin
405 MessageDlg(SNoLinesAvailable, mtInformation, [mbOk], 0);
406 exit;
407 end;
408
409 ind := GuessIndent(SynEdit1.Lines);
410 if ind <> -1 then val := IntToStr(ind);
411
412 InputQuery('Spaces to tabs', 'Indent:', val); // TODO: handle CANCEL correctly...
413 if TryStrToInt(Trim(val), ind) then
414 begin
415 if ind = 0 then exit;
416 SpaceToTab(SynEdit1.Lines, ind);
417 end;
418
419 if SynEdit1.CanFocus then SynEdit1.SetFocus;
420 end;
421
422 procedure TForm1.ActionESCExecute(Sender: TObject);
423 begin
424 if (HlpPrevPageIndex <> -1) and (PageControl2.ActivePage = HelpTabSheet) and
425 (HelpTabsheet.TabVisible) then
426 begin
427 PageControl2.ActivePageIndex := HlpPrevPageIndex;
428 HelpTabsheet.TabVisible := false;
429 end;
430
431 // Dirty hack...
432 SrcRep.CloseDialogs;
433 end;
434
435 procedure TForm1.ActionFindExecute(Sender: TObject);
436 begin
437 SrcRep.FindExecute;
438 end;
439
440 var
441 firstTimeBrowserLoad: boolean = true;
442 procedure TForm1.Run(Sender: TObject);
443 var
444 bakTS: TTabSheet;
445 //ss: TStringStream;
446 //bakPos: Int64;
447 begin
448 memo2.Lines.Text := '';
449
450 if firstTimeBrowserLoad then
451 begin
452 bakTS := PageControl1.ActivePage;
453 try
454 PageControl1.ActivePage := HtmlTabSheet; // Required for the first time, otherwise, WebBrowser1.Clear will hang
455 Webbrowser1.Clear;
456 finally
457 PageControl1.ActivePage := bakTS;
458 end;
459 firstTimeBrowserLoad := false;
460 end
461 else
462 Webbrowser1.Clear;
463
464 Screen.Cursor := crHourGlass;
465 Application.ProcessMessages;
466
467 try
468 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.
469
470 // 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 !!!!!!!!
471 // TODO 70422 * <fastphp> wenn ein script hängt, soll man es abwürgen dürfen!!!!!!
472 memo2.Lines.Text := RunPHPScript(GetScrapFile, Sender=ActionLint, False);
473
474 {$REGION 'Show in Web Browser'}
475 Webbrowser1.LoadHTML(MarkUpLineReference(memo2.Lines.Text), GetScrapFile);
476
477 // Alternatively:
478 (*
479 ss := TstringStream.Create;
480 ss.WriteString(MarkUpLineReference(memo2.Lines.Text));
481 ss.Position := 0;
482 Webbrowser1.LoadStream(ss, GetScrapFile);
483 Webbrowser1.Wait;
484 ss.Free;
485 *)
486 {$ENDREGION}
487
488 if IsTextHTML(memo2.lines.text) then
489 PageControl1.ActivePage := HtmlTabSheet
490 else
491 PageControl1.ActivePage := PlaintextTabSheet;
492 finally
493 Screen.Cursor := crDefault;
494 end;
495 end;
496
497 procedure TForm1.RunConsole(Sender: TObject);
498 begin
499 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.
500 RunPHPScript(GetScrapFile, Sender=ActionLint, True);
501 end;
502
503 procedure TForm1.SynEdit1Change(Sender: TObject);
504 begin
505 RefreshModifySign;
506 end;
507
508 procedure TForm1.SynEdit1GutterClick(Sender: TObject; Button: TMouseButton; X,
509 Y, Line: Integer; Mark: TSynEditMark);
510 begin
511 (*
512 TSynEdit(Sender).CaretX := 1;
513 TSynEdit(Sender).CaretY := Line;
514 TSynEdit(Sender).SelLength := Length(TSynEdit(Sender).LineText);
515 *)
516 end;
517
518 procedure TForm1.SynEdit1MouseCursor(Sender: TObject; const aLineCharPos: TBufferCoord; var aCursor: TCursor);
519 {$IFDEF OnlineHelp}
520 var
521 Line: Integer;
522 Column: Integer;
523 word: string;
524 begin
525 Line := aLineCharPos.Line-1;
526 Column := aLineCharPos.Char-1;
527 word := GetWordUnderPos(TSynEdit(Sender), Line, Column);
528 if word <> gOnlineHelpWord then
529 begin
530 gOnlineHelpWord := word;
531 Timer1.Enabled := false;
532 Timer1.Enabled := true;
533 end;
534 {$ELSE}
535 begin
536 {$ENDIF}
537 end;
538
539 procedure TForm1.SynEdit1MouseWheelDown(Sender: TObject; Shift: TShiftState;
540 MousePos: TPoint; var Handled: Boolean);
541 begin
542 if ssCtrl in Shift then
543 begin
544 SynEdit1.Font.Size := Max(SynEdit1.Font.Size - 1, 5);
545 Handled := true;
546 end
547 else Handled := false;
548 end;
549
550 procedure TForm1.SynEdit1MouseWheelUp(Sender: TObject; Shift: TShiftState;
551 MousePos: TPoint; var Handled: Boolean);
552 begin
553 if ssCtrl in Shift then
554 begin
555 SynEdit1.Font.Size := SynEdit1.Font.Size + 1;
556 Handled := true;
557 end
558 else Handled := false;
559 end;
560
561 procedure TForm1.SynEdit1PaintTransient(Sender: TObject; Canvas: TCanvas; TransientType: TTransientType);
562 var
563 Editor: TSynEdit;
564 OpenChars: array of WideChar;//[0..2] of WideChar=();
565 CloseChars: array of WideChar;//[0..2] of WideChar=();
566
567 function IsCharBracket(AChar: WideChar): Boolean;
568 begin
569 case AChar of
570 '{','[','(','<','}',']',')','>':
571 Result := True;
572 else
573 Result := False;
574 end;
575 end;
576
577 function CharToPixels(P: TBufferCoord): TPoint;
578 begin
579 Result := Editor.RowColumnToPixels(Editor.BufferToDisplayPos(P));
580 end;
581
582 var
583 COLOR_FG: TColor;
584 COLOR_BG: TColor;
585 P: TBufferCoord;
586 Pix: TPoint;
587 D: TDisplayCoord;
588 S: UnicodeString;
589 I: Integer;
590 Attri: TSynHighlighterAttributes;
591 ArrayLength: Integer;
592 start: Integer;
593 TmpCharA, TmpCharB: WideChar;
594 begin
595 // Source: https://github.com/SynEdit/SynEdit/blob/master/Demos/OnPaintTransientDemo/Unit1.pas
596
597 if IsThemeDark then
598 begin
599 COLOR_FG := clLime;
600 COLOR_BG := clGreen;
601 end
602 else
603 begin
604 COLOR_FG := clGreen;
605 COLOR_BG := clLime;
606 end;
607
608 if TSynEdit(Sender).SelAvail then exit;
609 Editor := TSynEdit(Sender);
610 ArrayLength:= 3;
611
612 (*
613 if (Editor.Highlighter = shHTML) or (Editor.Highlighter = shXML) then
614 inc(ArrayLength);
615 *)
616
617 SetLength(OpenChars, ArrayLength);
618 SetLength(CloseChars, ArrayLength);
619 for i := 0 to ArrayLength - 1 do
620 begin
621 case i of
622 0: begin OpenChars[i] := '('; CloseChars[i] := ')'; end;
623 1: begin OpenChars[i] := '{'; CloseChars[i] := '}'; end;
624 2: begin OpenChars[i] := '['; CloseChars[i] := ']'; end;
625 3: begin OpenChars[i] := '<'; CloseChars[i] := '>'; end;
626 end;
627 end;
628
629 P := Editor.CaretXY;
630 D := Editor.DisplayXY;
631
632 Start := Editor.SelStart;
633
634 if (Start > 0) and (Start <= length(Editor.Text)) then
635 TmpCharA := Editor.Text[Start]
636 else
637 TmpCharA := #0;
638
639 if (Start > 0){Added by VTS} and (Start < length(Editor.Text)) then
640 TmpCharB := Editor.Text[Start + 1]
641 else
642 TmpCharB := #0;
643
644 if not IsCharBracket(TmpCharA) and not IsCharBracket(TmpCharB) then exit;
645 S := TmpCharB;
646 if not IsCharBracket(TmpCharB) then
647 begin
648 P.Char := P.Char - 1;
649 S := TmpCharA;
650 end;
651 Editor.GetHighlighterAttriAtRowCol(P, S, Attri);
652
653 if (Editor.Highlighter.SymbolAttribute = Attri) then
654 begin
655 for i := low(OpenChars) to High(OpenChars) do
656 begin
657 if (S = OpenChars[i]) or (S = CloseChars[i]) then
658 begin
659 Pix := CharToPixels(P);
660
661 Editor.Canvas.Brush.Style := bsSolid;//Clear;
662 Editor.Canvas.Font.Assign(Editor.Font);
663 Editor.Canvas.Font.Style := Attri.Style;
664
665 if (TransientType = ttAfter) then
666 begin
667 Editor.Canvas.Font.Color := COLOR_FG;
668 Editor.Canvas.Brush.Color := COLOR_BG;
669 end
670 else
671 begin
672 Editor.Canvas.Font.Color := Attri.Foreground;
673 Editor.Canvas.Brush.Color := Attri.Background;
674 end;
675 if Editor.Canvas.Font.Color = clNone then
676 Editor.Canvas.Font.Color := Editor.Font.Color;
677 if Editor.Canvas.Brush.Color = clNone then
678 Editor.Canvas.Brush.Color := Editor.Color;
679
680 Editor.Canvas.TextOut(Pix.X, Pix.Y, S);
681 P := Editor.GetMatchingBracketEx(P);
682
683 if (P.Char > 0) and (P.Line > 0) then
684 begin
685 Pix := CharToPixels(P);
686 if Pix.X > Editor.Gutter.Width then
687 begin
688 {$REGION 'Added by ViaThinkSoft'}
689 if (TransientType = ttAfter) then
690 begin
691 Editor.Canvas.Font.Color := COLOR_FG;
692 Editor.Canvas.Brush.Color := COLOR_BG;
693 end
694 else
695 begin
696 Editor.Canvas.Font.Color := Attri.Foreground;
697 Editor.Canvas.Brush.Color := Attri.Background;
698 end;
699 if Editor.Canvas.Font.Color = clNone then
700 Editor.Canvas.Font.Color := Editor.Font.Color;
701 if Editor.Canvas.Brush.Color = clNone then
702 Editor.Canvas.Brush.Color := Editor.Color;
703 {$ENDREGION}
704 if S = OpenChars[i] then
705 Editor.Canvas.TextOut(Pix.X, Pix.Y, CloseChars[i])
706 else Editor.Canvas.TextOut(Pix.X, Pix.Y, OpenChars[i]);
707 end;
708 end;
709 end;
710 end;
711 Editor.Canvas.Brush.Style := bsSolid;
712 end;
713 end;
714
715 procedure TForm1.SynEditFocusTimerTimer(Sender: TObject);
716 begin
717 SynEditFocusTimer.Enabled := false;
718 Button1.SetFocus; // Workaround for weird bug... This (and the timer) is necessary to get the focus to SynEdit1
719 SynEdit1.SetFocus;
720 end;
721
722 procedure TForm1.Theme_Dark;
723 begin
724 if IsThemeDark then exit;
725 TStyleManager.TrySetStyle('Windows10 SlateGray');
726 Color := 1316887;
727 Font.Color := clCream;
728 //Memo2.Font.Color := clCream;
729 //Memo2.ParentColor := true;
730 SynEdit1.ActiveLineColor := 2238502;
731 SynEdit1.Color := 1316887;
732 SynEdit1.Font.Color := clCream;
733 SynEdit1.Gutter.Color := 1316887;
734 SynEdit1.Gutter.Font.Color := clCream;
735 SynEdit1.Gutter.GradientStartColor := 2238502;
736 SynEdit1.Gutter.GradientEndColor := 1316887;
737 SynPHPSyn1.CommentAttri.Foreground := $00837B82;
738 SynPHPSyn1.IdentifierAttri.Foreground := 9627120;
739 SynPHPSyn1.KeyAttri.Foreground := 4157595;
740 SynPHPSyn1.NumberAttri.Foreground := 5008079;
741 SynPHPSyn1.StringAttri.Foreground := 6987151;
742 SynPHPSyn1.SymbolAttri.Foreground := 8769754;
743 SynPHPSyn1.VariableAttri.Foreground := 6924493;
744 end;
745
746 procedure TForm1.Theme_Light;
747 begin
748 if not IsThemeDark then exit;
749 TStyleManager.TrySetStyle('Windows');
750 Color := clBtnFace;
751 Font.Color := clWindowText;
752 //Memo2.Font.Color := clWindowText;
753 SynEdit1.ActiveLineColor := 14680010;
754 SynEdit1.Color := clWindow;
755 SynEdit1.Font.Color := clWindowText;
756 SynEdit1.Gutter.Color := clBtnFace;
757 SynEdit1.Gutter.Font.Color := clWindowText;
758 SynEdit1.Gutter.GradientStartcolor := cl3dLight;
759 SynEdit1.Gutter.GradientEndColor := clBtnFace;;
760 SynPHPSyn1.CommentAttri.Foreground := 33023;
761 SynPHPSyn1.IdentifierAttri.Foreground := 4194304;
762 SynPHPSyn1.KeyAttri.Foreground := 4227072;
763 SynPHPSyn1.NumberAttri.Foreground := 213;
764 SynPHPSyn1.StringAttri.Foreground := 13762560;
765 SynPHPSyn1.SymbolAttri.Foreground := 4227072;
766 SynPHPSyn1.VariableAttri.Foreground := 213;
767 end;
768
769 procedure TForm1.Timer1Timer(Sender: TObject);
770 begin
771 {$IFDEF OnlineHelp}
772 Timer1.Enabled := false;
773
774 // TODO: Insert a small online help hint
775 //Caption := gOnlineHelpWord;
776 {$ENDIF}
777 end;
778
779 procedure TForm1.TreeView1DblClick(Sender: TObject);
780 var
781 tn: TTreeNode;
782 lineNo: integer;
783 begin
784 tn := TTreeView(Sender).Selected;
785 if tn = nil then exit;
786 lineNo := Integer(tn.Data);
787 if lineNo > 0 then GotoLineNo(lineNo);
788 end;
789
790 (*
791 {$IFDEF USE_SHDOCVW_TLB}
792 *)
793 procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject;
794 const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
795 Headers: OleVariant; var Cancel: WordBool);
796 begin
797 BeforeNavigate(URL, Cancel);
798 end;
799 (*
800 {$ELSE}
801 procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject;
802 const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
803 Headers: OleVariant; var Cancel: WordBool);
804 begin
805 BeforeNavigate(URL, Cancel);
806 end;
807 {$ENDIF}
808 *)
809
810 procedure TForm1.WebBrowser1WindowClosing(ASender: TObject;
811 IsChildWindow: WordBool; var Cancel: WordBool);
812 resourcestring
813 LNG_CLOSE_REQUEST = 'A script has requested the window to be closed. The window of a standalone script would now close.';
814 begin
815 ShowMessage(LNG_CLOSE_REQUEST);
816 TWebBrowser(ASender).Clear;
817 Cancel := true;
818 end;
819
820 procedure TForm1.BeforeNavigate(const URL: OleVariant; var Cancel: WordBool);
821 var
822 s, myURL: string;
823 lineno: integer;
824 p: integer;
825 begin
826 {$REGION 'Line number references (PHP errors and warnings)'}
827 if Copy(URL, 1, length(FASTPHP_GOTO_URI_PREFIX)) = FASTPHP_GOTO_URI_PREFIX then
828 begin
829 try
830 s := copy(URL, length(FASTPHP_GOTO_URI_PREFIX)+1, 99);
831 if not TryStrToInt(s, lineno) then exit;
832 GotoLineNo(lineno);
833 SynEditFocusTimer.Enabled := true;
834 finally
835 Cancel := true;
836 end;
837 Exit;
838 end;
839 {$ENDREGION}
840
841 {$REGION 'Intelligent browser (executes PHP scripts which are clicked in a hyperlink)'}
842 if URL <> 'about:blank' then
843 begin
844 myUrl := URL;
845
846 p := Pos('?', myUrl);
847 if p >= 1 then myURL := copy(myURL, 1, p-1);
848
849 // TODO: myURL urldecode
850 // TODO: maybe we could even open that file in the editor!
851 // TODO: ?parameter=....
852
853 if FileExists(myURL) and (EndsText('.php', myURL) or EndsText('.php3', myURL) or EndsText('.php4', myURL) or EndsText('.php5', myURL) or EndsText('.phps', myURL)) then
854 begin
855 WebBrowser1.LoadHTML(RunPHPScript(myURL), myUrl);
856 Cancel := true;
857 end;
858 end;
859 {$ENDREGION}
860 end;
861
862 procedure TForm1.BtnLightClick(Sender: TObject);
863 var
864 CanClose: boolean;
865 begin
866 FormCloseQuery(Form1, CanClose);
867 if not CanClose then exit;
868
869 if IsThemeDark then
870 begin
871 BtnLight.Picture.Assign(BtnLightOn.Picture);
872 Theme_Light;
873 TFastPHPConfig.DarkTheme := false;
874 end
875 else
876 begin
877 BtnLight.Picture.Assign(BtnLightOff.Picture);
878 Theme_Dark;
879 TFastPHPConfig.DarkTheme := true;
880 end;
881 end;
882
883 procedure TForm1.BtnSpecialCharsClick(Sender: TObject);
884 var
885 opts: TSynEditorOptions;
886 begin
887 opts := SynEdit1.Options;
888 if eoShowSpecialChars in SynEdit1.Options then
889 begin
890 BtnSpecialChars.Picture.Assign(BtnSpecialCharsOff.Picture);
891 Exclude(opts, eoShowSpecialChars);
892 TFastPHPConfig.SpecialChars := false;
893 end
894 else
895 begin
896 BtnSpecialChars.Picture.Assign(BtnSpecialCharsOn.Picture);
897 Include(opts, eoShowSpecialChars);
898 TFastPHPConfig.SpecialChars := true;
899 end;
900 SynEdit1.Options := opts;
901 end;
902
903 procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
904 begin
905 TFastPHPConfig.FontSize := SynEdit1.Font.Size;
906 end;
907
908 procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
909 var
910 r: integer;
911 begin
912 if SynEdit1.Modified then
913 begin
914 if (ParamStr(1) <> '') or (FSaveAsFilename <> '') then
915 begin
916 r := MessageDlg('Do you want to save?', mtConfirmation, mbYesNoCancel, 0);
917 if r = mrCancel then
918 begin
919 CanClose := false;
920 Exit;
921 end
922 else if r = mrYes then
923 begin
924 ActionSave.Execute;
925 CanClose := true;
926 end;
927 end
928 else
929 begin
930 ActionSave.Execute;
931 CanClose := true;
932 end;
933 end;
934 end;
935
936 procedure TForm1.FormCreate(Sender: TObject);
937 var
938 exeDir: string;
939 begin
940 HlpPrevPageIndex := -1;
941 CurSearchTerm := '';
942 Caption := Caption + ' - ' + GetScrapFile;
943 SrcRep := TSynEditFindReplace.Create(self);
944 SrcRep.Editor := SynEdit1;
945 SynEdit1.Gutter.Gradient := HighColorWindows;
946
947 Screen.Cursors[crMouseGutter] := LoadCursor(hInstance, 'MOUSEGUTTER');
948 SynEdit1.Gutter.Cursor := crMouseGutter;
949
950 exeDir := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
951 if FileExists(exeDir + 'codeexplorer.bmp') then ImageList1.LoadAndSplitImages(exeDir + 'codeexplorer.bmp');
952 end;
953
954 procedure TForm1.FormDestroy(Sender: TObject);
955 begin
956 if Assigned(ChmIndex) then
957 begin
958 FreeAndNil(ChmIndex);
959 end;
960 FreeAndNil(SrcRep);
961
962 if hMutex <> 0 then CloseHandle(hMutex); // Note: ReleaseMutex does not work as expected!
963
964 if Assigned(codeExplorer) then
965 begin
966 codeExplorer.Terminate;
967 codeExplorer.WaitFor;
968 FreeAndNil(codeExplorer);
969 end;
970 end;
971
972 var
973 FormShowRanOnce: boolean;
974 procedure TForm1.FormShow(Sender: TObject);
975 var
976 ScrapFile: string;
977 tmpFontSize: integer;
978 opts: TSynEditorOptions;
979 begin
980 if FormShowRanOnce then exit; // If the theme is changed from normal to dark, OnShow will be called another time
981 FormShowRanOnce := true;
982
983 ScrapFile := GetScrapFile;
984 if ScrapFile = '' then
985 begin
986 Application.Terminate; // Close;
987 exit;
988 end;
989
990 opts := SynEdit1.Options;
991 if TFastPHPConfig.SpecialChars then
992 begin
993 BtnSpecialChars.Picture.Assign(BtnSpecialCharsOn.Picture);
994 Include(opts, eoShowSpecialChars);
995 end
996 else
997 begin
998 BtnSpecialChars.Picture.Assign(BtnSpecialCharsOff.Picture);
999 Exclude(opts, eoShowSpecialChars);
1000 end;
1001 SynEdit1.Options := opts;
1002
1003 if FileExists(ScrapFile) then
1004 begin
1005 if hMutex = 0 then
1006 begin
1007 hMutex := CreateMutex(nil, True, PChar('FastPHP'+md5(UpperCase(ScrapFile))));
1008 if GetLastError = ERROR_ALREADY_EXISTS then
1009 begin
1010 // TODO: It would be great if the window of that FastPHP instance would switched to foreground
1011 ShowMessageFmt('File "%s" is alrady open!', [ScrapFile]);
1012 Close;
1013 end;
1014
1015 SynEdit1.Lines.LoadFromFile(ScrapFile);
1016 end;
1017 end
1018 else
1019 SynEdit1.Lines.Clear;
1020
1021 PageControl1.ActivePage := PlaintextTabSheet;
1022
1023 PageControl2.ActivePage := CodeTabsheet;
1024 HelpTabsheet.TabVisible := false;
1025
1026 tmpFontSize := TFastPHPConfig.FontSize;
1027 if tmpFontSize <> -1 then SynEdit1.Font.Size := tmpFontSize;
1028 SynEdit1.SetFocus;
1029
1030 DoubleBuffered := true;
1031 StartCodeExplorer;
1032
1033 StartupTimer.Enabled := true;
1034 end;
1035
1036 procedure TForm1.Save1Click(Sender: TObject);
1037 begin
1038 Button7.Click;
1039 end;
1040
1041 procedure TForm1.Saveas1Click(Sender: TObject);
1042 var
1043 hMutexNew: THandle;
1044 begin
1045 if SaveDialog1.Execute then
1046 begin
1047 {$REGION 'Switch mutex'}
1048 hMutexNew := CreateMutex(nil, True, PChar('FastPHP'+md5(UpperCase(SaveDialog1.FileName))));
1049 if GetLastError = ERROR_ALREADY_EXISTS then
1050 begin
1051 ShowMessageFmt('Cannot save because file "%s", because it is alrady open in another FastPHP window!', [SaveDialog1.FileName]);
1052 Close;
1053 end;
1054
1055 if hMutex <> 0 then CloseHandle(hMutex); // Note: ReleaseMutex does not work as expected!
1056 hMutex := hMutexNew;
1057 {$ENDREGION}
1058
1059 FSaveAsFilename := SaveDialog1.FileName;
1060 Caption := Copy(Caption, 1, Pos(' - ', Caption)-1) + ' - ' + FSaveAsFilename;
1061 Button7.Click;
1062 end;
1063 end;
1064
1065 procedure TForm1.SaveToFile(filename: string);
1066 var
1067 ss: TStringStream;
1068 ms: TMemoryStream;
1069 fs: TFileStream;
1070 eolStyle: string;
1071 str: string;
1072 begin
1073 ms := TMemoryStream.Create;
1074 ss := TStringStream.Create('');
1075 fs := TFileStream.Create(filename, fmCreate);
1076 try
1077 // Save everything in a memory stream and then to a string
1078 // in comparison to "str := SynEdit1.Lines.Text;",
1079 // This approach should preserve LF / CRLF line endings
1080 SynEdit1.Lines.SaveToStream(ms);
1081 ms.Position := 0;
1082 ss.CopyFrom(ms, ms.Size);
1083 ss.Position := 0;
1084 str := ss.ReadString(ss.Size);
1085 ss.Size := 0; // clear string-stream, because we need it later again
1086
1087 // Detect current line-endings
1088 if Copy(str, 1, 2) = '#!' then
1089 begin
1090 // Shebang. Use ONLY Linux LF
1091 str := StringReplace(str, #13#10, #10, [rfReplaceAll]);
1092 eolStyle := #10 // Linux LF
1093 end
1094 else
1095 begin
1096 if Pos(#13#10, str) > 0 then
1097 eolStyle := #13#10 // Windows CRLF
1098 else if Pos(#10, str) > 0 then
1099 eolStyle := #10 // Linux LF
1100 else
1101 begin
1102 if DefaultTextLineBreakStyle = tlbsLF then
1103 eolStyle := #10 // Linux LF
1104 else if DefaultTextLineBreakStyle = tlbsCRLF then
1105 eolStyle := #13#10 // Windows CRLF
1106 //else if DefaultTextLineBreakStyle = tlbsCR then
1107 // eolStyle := #13 // Old Mac CR
1108 else
1109 eolStyle := #13#10; // (Should not happen)
1110 end;
1111 end;
1112
1113 // Unitfy line-endings
1114 str := StringReplace(str, #13#10, eolStyle, [rfReplaceAll]);
1115 str := StringReplace(str, #10, eolStyle, [rfReplaceAll]);
1116 str := StringReplace(str, #13, '', [rfReplaceAll]);
1117
1118 // Replace all trailing linebreaks by a single line break
1119 // Note: Removing all line breaks is not good, since Linux's "nano" will
1120 // re-add a linebreak at the end of the file
1121 str := TrimRight(str) + eolStyle;
1122
1123 // Old versions of Delphi/SynEdit write an UTF-8 BOM, which makes problems
1124 // e.g. with AJAX handlers (because AJAX reponses must not have a BOM).
1125 // So we try to avoid that.
1126 // Note that the output is still UTF-8 encoded if the input file was UTF-8 encoded
1127 if Copy(str,1,3) = #$EF#$BB#$BF then Delete(str, 1, 3);
1128
1129 // Now save to the file
1130 ss.WriteString(str);
1131 ss.Position := 0;
1132 fs.CopyFrom(ss, ss.Size-ss.Position);
1133 finally
1134 FreeAndNil(ms);
1135 FreeAndNil(ss);
1136 FreeAndNil(fs);
1137 end;
1138 end;
1139
1140 procedure TForm1.StartCodeExplorer;
1141 begin
1142 codeExplorer := TRunCodeExplorer.Create(true);
1143 codeExplorer.InputRequestCallback := InputRequestCallback;
1144 codeExplorer.OutputNotifyCallback := OutputNotifyCallback;
1145 codeExplorer.PhpExe := GetPHPExe;
1146 codeExplorer.PhpFile := IncludeTrailingPathDelimiter(ExtractFileDir(Application.ExeName)) + 'codeexplorer.php'; // GetScrapFile;
1147 codeExplorer.WorkDir := ExtractFileDir(Application.ExeName);
1148 codeExplorer.Resume;
1149 end;
1150
1151 procedure TForm1.StartUpTimerTimer(Sender: TObject);
1152 begin
1153 StartupTimer.Enabled := false;
1154
1155 // We need this timer because we cannot change the Theme during OnShow,
1156 // because the Delphi VCL Theme is buggy!
1157
1158 if TFastPHPConfig.DarkTheme then
1159 begin
1160 BtnLight.Picture.Assign(BtnLightOff.Picture);
1161 Theme_Dark;
1162 end
1163 else
1164 begin
1165 BtnLight.Picture.Assign(BtnLightOn.Picture);
1166 Theme_Light;
1167 end;
1168 end;
1169
1170 function TForm1.GetScrapFile: string;
1171 var
1172 tmpPath: string;
1173 begin
1174 if FSaveAsFilename <> '' then
1175 begin
1176 result := FSaveAsFilename;
1177 exit;
1178 end;
1179
1180 if FScrapFile <> '' then
1181 begin
1182 result := FScrapFile;
1183 exit;
1184 end;
1185
1186 if ParamStr(1) <> '' then
1187 begin
1188 // Program was started with a filename
1189
1190 result := ParamStr(1);
1191
1192 if not FileExists(result) then
1193 begin
1194 case MessageDlg(Format('File %s does not exist. Create it?', [result]), mtConfirmation, mbYesNoCancel, 0) of
1195 mrYes:
1196 try
1197 SaveToFile(result);
1198 except
1199 on E: Exception do
1200 begin
1201 MessageDlg(E.Message, mtError, [mbOk], 0);
1202 Application.Terminate;
1203 result := '';
1204 exit;
1205 end;
1206 end;
1207 mrNo:
1208 begin
1209 Application.Terminate;
1210 result := '';
1211 exit;
1212 end;
1213 mrCancel:
1214 begin
1215 Application.Terminate;
1216 result := '';
1217 exit;
1218 end;
1219 end;
1220 end;
1221 end
1222 else
1223 begin
1224 // Program is started without filename -> use scrap file
1225
1226 result := TFastPHPConfig.ScrapFile;
1227
1228 if not FileExists(result) then
1229 begin
1230 repeat
1231 {$REGION 'Determinate opendialog initial directory'}
1232 if result <> '' then
1233 begin
1234 tmpPath := ExtractFilePath(result);
1235 if DirectoryExists(tmpPath) then
1236 begin
1237 OpenDialog3.InitialDir := tmpPath;
1238 OpenDialog3.FileName := Result;
1239 end
1240 else
1241 begin
1242 OpenDialog3.InitialDir := GetMyDocumentsFolder;
1243 end;
1244 end
1245 else
1246 begin
1247 OpenDialog3.InitialDir := GetMyDocumentsFolder;
1248 end;
1249 {$ENDREGION}
1250
1251 if not OpenDialog3.Execute then
1252 begin
1253 Application.Terminate;
1254 result := '';
1255 exit;
1256 end;
1257
1258 if not DirectoryExists(ExtractFilePath(OpenDialog3.FileName)) then
1259 begin
1260 MessageDlg('Path does not exist! Please try again.', mtWarning, [mbOk], 0);
1261 end
1262 else
1263 begin
1264 result := OpenDialog3.FileName;
1265 end;
1266 until result <> '';
1267
1268 if not FileExists(result) then
1269 begin
1270 try
1271 // Try saving the file; check if we have permissions
1272 //SynEdit1.Lines.Clear;
1273 SaveToFile(result);
1274 except
1275 on E: Exception do
1276 begin
1277 MessageDlg(E.Message, mtError, [mbOk], 0);
1278 Application.Terminate;
1279 result := '';
1280 exit;
1281 end;
1282 end;
1283 end;
1284
1285 TFastPHPConfig.ScrapFile := result;
1286 FScrapFile := result;
1287 end;
1288 end;
1289 end;
1290
1291 procedure TForm1.Help;
1292 var
1293 IndexFile, chmFile, w, OriginalWord, url: string;
1294 internalHtmlFile: string;
1295 begin
1296 if not Assigned(ChmIndex) then
1297 begin
1298 IndexFile := TFastPHPConfig.HelpIndex;
1299 IndexFile := ChangeFileExt(IndexFile, '.ini'); // Just to be sure. Maybe someone wrote manually the ".chm" file in there
1300 if FileExists(IndexFile) then
1301 begin
1302 ChmIndex := TMemIniFile.Create(IndexFile);
1303 end;
1304 end;
1305
1306 if Assigned(ChmIndex) then
1307 begin
1308 IndexFile := TFastPHPConfig.HelpIndex;
1309 // We don't check if IndexFile still exists. It is not important since we have ChmIndex pre-loaded in memory
1310
1311 chmFile := ChangeFileExt(IndexFile, '.chm');
1312 if not FileExists(chmFile) then
1313 begin
1314 FreeAndNil(ChmIndex);
1315 end;
1316 end;
1317
1318 if not Assigned(ChmIndex) then
1319 begin
1320 if not OpenDialog1.Execute then exit;
1321
1322 chmFile := OpenDialog1.FileName;
1323 if not FileExists(chmFile) then exit;
1324
1325 IndexFile := ChangeFileExt(chmFile, '.ini');
1326
1327 if not FileExists(IndexFile) then
1328 begin
1329 Panel1.Align := alClient;
1330 Panel1.Visible := true;
1331 Panel1.BringToFront;
1332 Screen.Cursor := crHourGlass;
1333 Application.ProcessMessages;
1334 try
1335 if not ParseCHM(chmFile) then
1336 begin
1337 MessageDlg('The CHM file is not a valid PHP documentation. Cannot use help.', mtError, [mbOk], 0);
1338 exit;
1339 end;
1340 finally
1341 Screen.Cursor := crDefault;
1342 Panel1.Visible := false;
1343 end;
1344
1345 if not FileExists(IndexFile) then
1346 begin
1347 MessageDlg('Unknown error. Cannot use help.', mtError, [mbOk], 0);
1348 exit;
1349 end;
1350 end;
1351
1352 TFastPHPConfig.HelpIndex := IndexFile;
1353
1354 ChmIndex := TMemIniFile.Create(IndexFile);
1355 end;
1356
1357 w := GetWordUnderCaret(SynEdit1);
1358 if w = '' then exit;
1359 {$IFDEF UNICODE}
1360 if CharInSet(w[1], ['0'..'9']) then exit;
1361 {$ELSE}
1362 if w[1] in ['0'..'9'] then exit;
1363 {$ENDIF}
1364
1365 Originalword := w;
1366 // w := StringReplace(w, '_', '-', [rfReplaceAll]);
1367 w := LowerCase(w);
1368 CurSearchTerm := w;
1369
1370 internalHtmlFile := ChmIndex.ReadString('function', CurSearchTerm, '');
1371 if internalHtmlFile = '' then
1372 internalHtmlFile := ChmIndex.ReadString('_HelpWords_', CurSearchTerm, '');
1373 if internalHtmlFile = '' then
1374 begin
1375 HelpTabsheet.TabVisible := false;
1376 HlpPrevPageIndex := -1;
1377 ShowMessageFmt('No help for "%s" available', [Originalword]);
1378 Exit;
1379 end;
1380
1381 url := 'mk:@MSITStore:'+ChmFile+'::'+internalHtmlFile;
1382
1383 HlpPrevPageIndex := PageControl2.ActivePageIndex; // Return by pressing ESC
1384 HelpTabsheet.TabVisible := true;
1385 PageControl2.ActivePage := HelpTabsheet;
1386 WebBrowser2.Navigate(url);
1387 WebBrowser2.Wait;
1388 end;
1389
1390 procedure TForm1.GotoLineNo(LineNo:integer);
1391 var
1392 line: string;
1393 i: integer;
1394 begin
1395 SynEdit1.GotoLineAndCenter(LineNo);
1396
1397 // Skip indent
1398 line := SynEdit1.Lines[SynEdit1.CaretY];
1399 for i := 1 to Length(line) do
1400 begin
1401 {$IFDEF UNICODE}
1402 if not CharInSet(line[i], [' ', #9]) then
1403 {$ELSE}
1404 if not (line[i] in [' ', #9]) then
1405 {$ENDIF}
1406 begin
1407 SynEdit1.CaretX := i-1;
1408 break;
1409 end;
1410 end;
1411
1412 PageControl2.ActivePage := CodeTabsheet;
1413 if SynEdit1.CanFocus then SynEdit1.SetFocus;
1414 end;
1415
1416 procedure TForm1.PageControl2Changing(Sender: TObject;
1417 var AllowChange: Boolean);
1418 begin
1419 if PageControl2.ActivePage = HelpTabsheet then
1420 HlpPrevPageIndex := -1
1421 else
1422 HlpPrevPageIndex := PageControl2.ActivePageIndex;
1423
1424 AllowChange := true;
1425 end;
1426
1427 procedure TForm1.Memo2DblClick(Sender: TObject);
1428 var
1429 line: string;
1430
1431 procedure _process(toFind: string);
1432 var
1433 p, lineno: integer;
1434 begin
1435 if FileSystemCaseSensitive then
1436 p := Pos(toFind, line)
1437 else
1438 p := Pos(LowerCase(toFind), LowerCase(line));
1439 if p <> 0 then
1440 begin
1441 line := copy(line, p+length(toFind), 99);
1442 if not TryStrToInt(line, lineno) then exit;
1443 GotoLineNo(lineno);
1444 end;
1445 end;
1446
1447 begin
1448 line := memo2.Lines.Strings[Memo2.CaretPos.Y];
1449
1450 {$REGION 'Possibility 1: filename.php:lineno'}
1451 _process(ExtractFileName(GetScrapFile) + ':');
1452 {$ENDREGION}
1453
1454 {$REGION 'Possibility 2: on line xx'}
1455 _process(ExtractFileName(GetScrapFile) + ' on line ');
1456 {$ENDREGION}
1457 end;
1458
1459 procedure TForm1.Memo2KeyDown(Sender: TObject; var Key: Word;
1460 Shift: TShiftState);
1461 begin
1462 if ((ssCtrl in Shift) and (Key = 65)) then TMemo(Sender).SelectAll;
1463 end;
1464
1465 function TForm1.MarkUpLineReference(cont: string): string;
1466
1467 procedure _process(toFind: string);
1468 var
1469 p, a, b: integer;
1470 num: integer;
1471 insert_a, insert_b: string;
1472 begin
1473 if FileSystemCaseSensitive then
1474 p := Pos(toFind, cont)
1475 else
1476 p := Pos(LowerCase(toFind), LowerCase(cont));
1477 while p >= 1 do
1478 begin
1479 a := p;
1480 b := p + length(toFind);
1481 num := 0;
1482 {$IFDEF UNICODE}
1483 while CharInSet(cont[b], ['0'..'9']) do
1484 {$ELSE}
1485 while cont[b] in ['0'..'9'] do
1486 {$ENDIF}
1487 begin
1488 num := num*10 + StrToInt(cont[b]);
1489 inc(b);
1490 end;
1491
1492 insert_b := '</a>';
1493 insert_a := '<a href="' + FASTPHP_GOTO_URI_PREFIX + IntToStr(num) + '">';
1494
1495 insert(insert_b, cont, b);
1496 insert(insert_a, cont, a);
1497
1498 p := b + Length(insert_a) + Length(insert_b);
1499
1500 p := PosEx(toFind, cont, p+1);
1501 end;
1502 end;
1503
1504 begin
1505 {$REGION 'Possibility 1: filename.php:lineno'}
1506 _process(ExtractFileName(GetScrapFile) + ':');
1507 {$ENDREGION}
1508
1509 {$REGION 'Possibility 2: on line xx'}
1510 _process(ExtractFileName(GetScrapFile) + ' on line ');
1511 {$ENDREGION}
1512
1513 result := cont;
1514 end;
1515
1516 function TForm1.InputRequestCallback(var data: AnsiString): boolean;
1517 begin
1518 data := UTF8Encode(SynEdit1.Text);
1519 result := true;
1520 end;
1521
1522 function TForm1.IsThemeDark: boolean;
1523 begin
1524 result := Assigned(TStyleManager.ActiveStyle) and (TStyleManager.ActiveStyle.Name<>'Windows');
1525 end;
1526
1527 function TForm1.OutputNotifyCallback(const data: AnsiString): boolean;
1528 begin
1529 result := TreeView1.FillWithFastPHPData(data);
1530 end;
1531
1532 end.