1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20 }
21 unit JumpHistoryView;
22
23 {$mode objfpc}{$H+}
24
25 interface
26
27 uses
28 Classes, SysUtils,
29 // LCL
30 Forms, Controls, StdCtrls, Menus,
31 // LazUtils
32 LazUTF8, LazStringUtils,
33 // CodeTools
34 CodeToolManager, CodeCache,
35 // IDE
36 IDEOptionDefs, EnvironmentOpts, LazarusIDEStrConsts, Project, ProjectDefs;
37
38 type
39
40 { TJumpHistoryViewWin }
41
42 TJumpHistoryViewWin = class(TForm)
43 listHistory : TListBox;
44 procedure FormCreate(Sender : TObject);
45 procedure listHistoryClick(Sender : TObject);
46 procedure listHistoryDblClick(Sender : TObject);
47 procedure listHistoryKeyPress(Sender: TObject; var Key: char);
48 procedure OnIdle(Sender : TObject; var {%H-}Done: Boolean);
49 private
50 { private declarations }
51 fOnSelectionChanged : TNotifyEvent;
52 fProjectChangeStamp: integer;
GetSelectedIndexnull53 function GetSelectedIndex : Integer;
BeautifyLinenull54 function BeautifyLine(const Filename: string; X, Y: integer;
55 const Line: string): string;
56 procedure InitDisplay;
57 protected
58 procedure IndexChanged(Sender: TObject; {%H-}Index: Integer);
59 procedure ListChanged(Sender: TObject; {%H-}Index: Integer);
60 public
61 { public declarations }
62 property SelectedIndex : Integer read GetSelectedIndex;
63 property OnSelectionChanged: TNotifyEvent read fOnSelectionChanged
64 write fOnSelectionChanged;
65 end;
66
67 var
68 JumpHistoryViewWin : TJumpHistoryViewWin = nil;
69
70 implementation
71
72 {$R *.lfm}
73
74 const
75 MaxTextLen = 80;
76
77 { TJumpHistoryViewWin }
78
79 procedure TJumpHistoryViewWin.FormCreate(Sender : TObject);
80 begin
81 Caption := lisJHJumpHistory;
82 Name := NonModalIDEWindowNames[nmiwJumpHistory];
83 InitDisplay;
84 Application.AddOnIdleHandler(@OnIdle);
85 end;
86
87 procedure TJumpHistoryViewWin.listHistoryClick(Sender : TObject);
88 begin
89 if EnvironmentOptions.MsgViewDblClickJumps then exit;
90 if Assigned(fOnSelectionChanged) then fOnSelectionChanged(self);
91 end;
92
93 procedure TJumpHistoryViewWin.listHistoryDblClick(Sender : TObject);
94 begin
95 if not EnvironmentOptions.MsgViewDblClickJumps then exit;
96 if Assigned(fOnSelectionChanged) then fOnSelectionChanged(self);
97 end;
98
99 procedure TJumpHistoryViewWin.listHistoryKeyPress(Sender: TObject; var Key: char);
100 begin
101 if Key = #13 then begin
102 if Assigned(fOnSelectionChanged) then fOnSelectionChanged(self);
103 end;
104 end;
105
106 procedure TJumpHistoryViewWin.OnIdle(Sender: TObject; var Done: Boolean);
107 begin
108 if (Project1<>nil)
109 and (Project1.JumpHistory.ChangeStamp<>fProjectChangeStamp) then
110 InitDisplay;
111 end;
112
GetSelectedIndexnull113 function TJumpHistoryViewWin.GetSelectedIndex : Integer;
114 begin
115 Result := listHistory.ItemIndex;
116 end;
117
BeautifyLinenull118 function TJumpHistoryViewWin.BeautifyLine(const Filename : string; X, Y : integer;
119 const Line : string) : string;
120 begin
121 Result:=SpecialCharsToHex(Line);
122 if UTF8Length(Result)>MaxTextLen then
123 Result:=UTF8Copy(Result,1,MaxTextLen)+'...';
124 Result:=Filename
125 +' ('+IntToStr(Y)
126 +','+IntToStr(X)+')'
127 +' '+Result;
128 end;
129
130 procedure TJumpHistoryViewWin.InitDisplay;
131 var
132 i : integer;
133 jh_item : TProjectJumpHistoryPosition;
134 SrcLine: String;
135 CodeBuf: TCodeBuffer;
136 Filename: String;
137 begin
138 if (Project1<>nil)
139 and (fProjectChangeStamp=Project1.JumpHistory.ChangeStamp) then exit;
140 listHistory.Items.BeginUpdate;
141 listHistory.Clear;
142 if (Project1<>nil) then begin
143 fProjectChangeStamp:=Project1.JumpHistory.ChangeStamp;
144 for i := 0 to Project1.JumpHistory.Count -1 do begin
145 jh_item := Project1.JumpHistory.Items[i];
146 SrcLine:='';
147 CodeBuf:=CodeToolBoss.LoadFile(jh_item.Filename,true,false);
148 if CodeBuf<>nil then
149 SrcLine:=CodeBuf.GetLine(jh_item.CaretXY.Y-1,false);
150 Filename:=jh_item.Filename;
151 if Project1<>nil then
152 Filename:=Project1.GetShortFilename(Filename,true);
153 listHistory.Items.Append
154 (BeautifyLine(Filename,
155 jh_item.CaretXY.X,
156 jh_item.CaretXY.Y,
157 SrcLine
158 )
159 );
160 end;
161 //DebugLn(['TJumpHistoryViewWin.InitDisplay Project1.JumpHistory.HistoryIndex=',Project1.JumpHistory.HistoryIndex]);
162 listHistory.ItemIndex := Project1.JumpHistory.HistoryIndex;
163 end;
164 listHistory.Items.EndUpdate;
165 end;
166
167 procedure TJumpHistoryViewWin.IndexChanged(Sender : TObject; Index : Integer);
168 begin
169 listHistory.ItemIndex := Project1.JumpHistory.HistoryIndex;
170 end;
171
172 procedure TJumpHistoryViewWin.ListChanged(Sender : TObject; Index : Integer);
173 begin
174 InitDisplay;
175 end;
176
177 end.
178