mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-23 00:51:28 +02:00
* tools macro fixes
+ tph writer + first things for resource files
This commit is contained in:
peter
parent
f002eda080
commit
cc15fb70fb
@ -89,11 +89,12 @@ BEGIN
|
||||
ReadSwitches(SwitchesPath);
|
||||
|
||||
MyApp.Init;
|
||||
|
||||
{ load all options after init because of open files }
|
||||
ReadINIFile;
|
||||
|
||||
{ Update IDE }
|
||||
if PrimaryFile<>'' then
|
||||
MyApp.UpdatePrimaryFile;
|
||||
MyApp.Update;
|
||||
|
||||
ProcessParams(false);
|
||||
|
||||
@ -118,7 +119,12 @@ BEGIN
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.16 1999-03-12 01:13:01 peter
|
||||
Revision 1.17 1999-03-16 12:38:06 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
Revision 1.16 1999/03/12 01:13:01 peter
|
||||
* use TryToOpen() with parameter files to overcome double opened files
|
||||
at startup
|
||||
|
||||
|
||||
@ -46,6 +46,9 @@ uses
|
||||
FPRedir,
|
||||
FPConst,FPVars,FPUtils,FPIntf,FPSwitch;
|
||||
|
||||
const
|
||||
LastStatusUpdate : longint = 0;
|
||||
|
||||
constructor TCompileStatusDialog.Init;
|
||||
var R: TRect;
|
||||
begin
|
||||
@ -117,8 +120,14 @@ end;
|
||||
****************************************************************************}
|
||||
|
||||
function CompilerStatus: boolean; {$ifndef FPC}far;{$endif}
|
||||
var TT: longint;
|
||||
begin
|
||||
TT:=GetDosTicks;
|
||||
if abs(TT-LastStatusUpdate)>=round(CompilerStatusUpdateDelay*18.2) then
|
||||
begin
|
||||
LastStatusUpdate:=TT;
|
||||
if SD<>nil then SD^.Update;
|
||||
end;
|
||||
CompilerStatus:=false;
|
||||
end;
|
||||
|
||||
@ -279,7 +288,12 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.17 1999-03-12 01:13:56 peter
|
||||
Revision 1.18 1999-03-16 12:38:07 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
Revision 1.17 1999/03/12 01:13:56 peter
|
||||
* flag if trytoopen should look for other extensions
|
||||
+ browser tab in the tools-compiler
|
||||
|
||||
|
||||
@ -26,6 +26,8 @@ const
|
||||
MaxRecentFileCount = 5;
|
||||
MaxToolCount = 16;
|
||||
|
||||
CompilerStatusUpdateDelay = 0.8; { in secs }
|
||||
|
||||
ININame = 'fp.ini';
|
||||
SwitchesName = 'fp.cfg';
|
||||
|
||||
@ -59,6 +61,14 @@ const
|
||||
{ Startup Option constants }
|
||||
soReturnToLastDir = $00000001;
|
||||
|
||||
{ Desktop Flag constants - what to include in the desktop file }
|
||||
dfHistoryLists = $00000001;
|
||||
dfClipboardContent = $00000002;
|
||||
dfWatches = $00000004;
|
||||
dfBreakpoints = $00000008;
|
||||
dfOpenWindows = $00000010;
|
||||
dfSymbolInformation = $00000020;
|
||||
|
||||
{ Command constants }
|
||||
cmShowClipboard = 201;
|
||||
cmFindProcedure = 206;
|
||||
@ -130,6 +140,7 @@ const
|
||||
cmSaveAsINI = 2013;
|
||||
cmSwitchesMode = 2014;
|
||||
cmBrowser = 2015;
|
||||
cmDesktopOptions = 2016;
|
||||
|
||||
cmHelpContents = 2100;
|
||||
cmHelpIndex = 2101;
|
||||
@ -192,6 +203,7 @@ const
|
||||
{ hcGrep = hcShift+cmGrep;}
|
||||
hcSwitchesMode = hcShift+cmSwitchesMode;
|
||||
hcBrowser = hcShift+cmBrowser;
|
||||
hcDesktopOptions = hcShift+cmDesktopOptions;
|
||||
hcAbout = hcShift+cmAbout;
|
||||
|
||||
hcSystemMenu = 9000;
|
||||
@ -294,11 +306,16 @@ implementation
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 1999-03-01 15:41:51 peter
|
||||
Revision 1.14 1999-03-16 12:38:08 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
Revision 1.13 1999/03/01 15:41:51 peter
|
||||
+ Added dummy entries for functions not yet implemented
|
||||
* MenuBar didn't update itself automatically on command-set changes
|
||||
* Fixed Debugging/Profiling options dialog
|
||||
* TCodeEditor converts spaces to tabs at save only if efUseTabChars is
set
|
||||
* TCodeEditor converts spaces to tabs at save only if efUseTabChars is set
|
||||
* efBackSpaceUnindents works correctly
|
||||
+ 'Messages' window implemented
|
||||
+ Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
|
||||
|
||||
@ -155,6 +155,7 @@ begin
|
||||
hcToolsBase..
|
||||
hcToolsBase+MaxToolCount
|
||||
: S:='User installed tool';
|
||||
hcASCIITable : S:='Show ASCII table';
|
||||
|
||||
hcOptionsMenu : S:='Setting for compiler, editor, mouse, etc.';
|
||||
hcSwitchesMode : S:='Select settings for normal, debug or release version';
|
||||
@ -170,6 +171,7 @@ begin
|
||||
hcPreferences : S:='Specify desktop settings';
|
||||
hcEditor : S:='Specify default editor settings';
|
||||
hcMouse : S:='Specify mouse settings';
|
||||
hcDesktopOptions: S:='Specify desktop settings';
|
||||
hcStartup : S:='Permanently change default startup options';
|
||||
hcColors : S:='Customize IDE colors for windows, menus, editors, etc.';
|
||||
hcOpenINI : S:='Load a previously saved options file';
|
||||
@ -377,11 +379,16 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 1999-03-01 15:41:53 peter
|
||||
Revision 1.12 1999-03-16 12:38:09 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
Revision 1.11 1999/03/01 15:41:53 peter
|
||||
+ Added dummy entries for functions not yet implemented
|
||||
* MenuBar didn't update itself automatically on command-set changes
|
||||
* Fixed Debugging/Profiling options dialog
|
||||
* TCodeEditor converts spaces to tabs at save only if efUseTabChars is
set
|
||||
* TCodeEditor converts spaces to tabs at save only if efUseTabChars is set
|
||||
* efBackSpaceUnindents works correctly
|
||||
+ 'Messages' window implemented
|
||||
+ Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
|
||||
|
||||
@ -32,6 +32,7 @@ type
|
||||
procedure Open(FileName: string);
|
||||
function OpenSearch(FileName: string) : boolean;
|
||||
procedure Idle; virtual;
|
||||
procedure Update;
|
||||
procedure HandleEvent(var Event: TEvent); virtual;
|
||||
procedure GetTileRect(var R: TRect); virtual;
|
||||
function GetPalette: PPalette; virtual;
|
||||
@ -40,8 +41,6 @@ type
|
||||
public
|
||||
procedure ShowUserScreen;
|
||||
procedure ShowIDEScreen;
|
||||
public
|
||||
procedure UpdatePrimaryFile;
|
||||
private
|
||||
Heap: PFPHeapView;
|
||||
procedure NewEditor;
|
||||
@ -83,6 +82,7 @@ type
|
||||
procedure Preferences;
|
||||
procedure EditorOptions(Editor: PEditor);
|
||||
procedure BrowserOptions(Browser: PBrowserWindow);
|
||||
procedure DesktopOptions;
|
||||
procedure Mouse;
|
||||
procedure StartUp;
|
||||
procedure Colors;
|
||||
@ -105,8 +105,8 @@ type
|
||||
function SearchRecentFile(AFileName: string): integer;
|
||||
procedure RemoveRecentFile(Index: integer);
|
||||
private
|
||||
procedure Update;
|
||||
procedure CurDirChanged;
|
||||
procedure UpdatePrimaryFile;
|
||||
procedure UpdateINIFile;
|
||||
procedure UpdateRecentFileList;
|
||||
procedure UpdateTools;
|
||||
@ -251,10 +251,11 @@ begin
|
||||
NewSubMenu('~E~nvironment', hcEnvironmentMenu, NewMenu(
|
||||
NewItem('~P~references...','', kbNoKey, cmPreferences, hcPreferences,
|
||||
NewItem('~E~ditor...','', kbNoKey, cmEditor, hcEditor,
|
||||
NewItem('~D~esktop...','', kbNoKey, cmDesktopOptions, hcDesktopOptions,
|
||||
NewItem('~M~ouse...','', kbNoKey, cmMouse, hcMouse,
|
||||
NewItem('~S~tartup...','', kbNoKey, cmStartup, hcStartup,
|
||||
NewItem('~C~olors...','', kbNoKey, cmColors, hcColors,
|
||||
nil)))))),
|
||||
nil))))))),
|
||||
NewLine(
|
||||
NewItem('~O~pen...','', kbNoKey, cmOpenINI, hcOpenINI,
|
||||
NewItem('~S~ave','', kbNoKey, cmSaveINI, hcSaveINI,
|
||||
@ -411,6 +412,7 @@ begin
|
||||
cmBrowserOptions : BrowserOptions(Event.InfoPtr);
|
||||
cmMouse : Mouse;
|
||||
cmStartup : StartUp;
|
||||
cmDesktopOptions: DesktopOptions;
|
||||
cmColors : Colors;
|
||||
cmOpenINI : OpenINI;
|
||||
cmSaveINI : SaveINI;
|
||||
@ -718,7 +720,12 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.22 1999-03-12 01:13:57 peter
|
||||
Revision 1.23 1999-03-16 12:38:10 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
Revision 1.22 1999/03/12 01:13:57 peter
|
||||
* flag if trytoopen should look for other extensions
|
||||
+ browser tab in the tools-compiler
|
||||
|
||||
|
||||
@ -484,7 +484,7 @@ var R,R2: TRect;
|
||||
items : PSItem;
|
||||
videomode : tvideomode;
|
||||
i,modevalue : longint;
|
||||
|
||||
|
||||
|
||||
function ToStr(l : longint) : string;
|
||||
|
||||
@ -498,7 +498,7 @@ var R,R2: TRect;
|
||||
|
||||
const
|
||||
color2str : array[false..true] of string = ('in b/w','in color');
|
||||
|
||||
|
||||
begin
|
||||
GetVideoMode(videomode);
|
||||
CountModes:=0;
|
||||
@ -512,7 +512,7 @@ begin
|
||||
items:=nil;
|
||||
r2.assign(2,3,24,17);
|
||||
while assigned(hp) do
|
||||
begin
|
||||
begin
|
||||
items:=NewSItem(ToStr(hp^.col)+'x'+ToStr(hp^.row)+' '+color2str[hp^.color],items);
|
||||
if (hp^.col=videomode.col) and (hp^.row=videomode.row) and
|
||||
(hp^.color=videomode.color) then
|
||||
@ -525,7 +525,7 @@ begin
|
||||
hp:=hp^.next;
|
||||
end;
|
||||
modevalue:=CountModes-modevalue-1;
|
||||
new(rb1,init(r2,items));
|
||||
new(rb1,init(r2,items));
|
||||
insert(rb1);
|
||||
rb1^.value:=modevalue;
|
||||
|
||||
@ -538,7 +538,7 @@ begin
|
||||
{ change video mode ? }
|
||||
if rb1^.value<>modevalue then
|
||||
begin
|
||||
|
||||
|
||||
end;
|
||||
end;
|
||||
Dispose(D, Done);
|
||||
@ -706,6 +706,38 @@ begin
|
||||
NotImplemented;
|
||||
end;
|
||||
|
||||
procedure TIDEApp.DesktopOptions;
|
||||
var R: TRect;
|
||||
D: PCenterDialog;
|
||||
CB: PCheckBoxes;
|
||||
begin
|
||||
R.Assign(0,0,40,10);
|
||||
New(D, Init(R, 'Desktop Preferences'));
|
||||
with D^ do
|
||||
begin
|
||||
GetExtent(R); R.Grow(-2,-2); Inc(R.A.Y); R.B.Y:=R.A.Y+6;
|
||||
New(CB, Init(R,
|
||||
NewSItem('~H~istory lists',
|
||||
NewSItem('~C~lipboard content',
|
||||
NewSItem('~W~atch expressions',
|
||||
NewSItem('~B~reakpoints',
|
||||
NewSItem('~O~pen windows',
|
||||
NewSItem('~S~ymbol information',
|
||||
nil))))))));
|
||||
CB^.Value:=DesktopFileFlags;
|
||||
Insert(CB);
|
||||
R.Move(0,-1); R.B.Y:=R.A.Y+1;
|
||||
Insert(New(PLabel, Init(R, '~P~reserved across sessions', CB)));
|
||||
end;
|
||||
InsertButtons(D);
|
||||
CB^.Select;
|
||||
if Desktop^.ExecView(D)=cmOK then
|
||||
begin
|
||||
DesktopFileFlags:=CB^.Value;
|
||||
end;
|
||||
Dispose(D, Done);
|
||||
end;
|
||||
|
||||
procedure TIDEApp.Mouse;
|
||||
var R,R2: TRect;
|
||||
D: PCenterDialog;
|
||||
@ -891,7 +923,12 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.20 1999-03-14 22:18:16 florian
|
||||
Revision 1.21 1999-03-16 12:38:12 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
Revision 1.20 1999/03/14 22:18:16 florian
|
||||
+ options/preferences dialog added, without function yet
|
||||
|
||||
Revision 1.19 1999/03/12 01:14:00 peter
|
||||
|
||||
@ -214,6 +214,31 @@ begin
|
||||
GetHotKeyName:=S;
|
||||
end;
|
||||
|
||||
function WriteToolMessagesToFile(FileName: string): boolean;
|
||||
var OK: boolean;
|
||||
f: text;
|
||||
M: PToolMessage;
|
||||
I: sw_integer;
|
||||
begin
|
||||
I:=0;
|
||||
Assign(f,FileName);
|
||||
{$I-}
|
||||
Rewrite(f);
|
||||
OK:=EatIO=0;
|
||||
if Assigned(ToolMessages) then
|
||||
while OK and (I<ToolMessages^.Count) do
|
||||
begin
|
||||
M:=ToolMessages^.At(I);
|
||||
writeln(f,GetStr(M^.Module)+#0+GetStr(M^.Text)+#0+IntToStr(M^.Row)+#0+IntToStr(M^.Col));
|
||||
Inc(I);
|
||||
OK:=EatIO=0;
|
||||
end;
|
||||
Close(f);
|
||||
EatIO;
|
||||
{$I+}
|
||||
WriteToolMessagesToFile:=OK;
|
||||
end;
|
||||
|
||||
constructor TTool.Init(const ATitle, AProgramPath, ACommandLine: string; AHotKey: word);
|
||||
begin
|
||||
inherited Init;
|
||||
@ -967,7 +992,7 @@ begin
|
||||
if ReadTill(S,')')=false then Err:=I else
|
||||
begin
|
||||
Consume(')');
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'');
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'')-1;
|
||||
ToolFilter:=S;
|
||||
CaptureToolTo:=capMessageWindow;
|
||||
end;
|
||||
@ -976,7 +1001,7 @@ begin
|
||||
begin
|
||||
if (Pass=2) then
|
||||
begin
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'');
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'')-1;
|
||||
CaptureToolTo:=capEditWindow;
|
||||
end;
|
||||
end else
|
||||
@ -986,13 +1011,13 @@ begin
|
||||
begin
|
||||
if W=nil then L:=0 else
|
||||
L:=W^.Editor^.CurPos.X+1;
|
||||
I:=I+ReplacePart(LastWordStart,I-1,IntToStr(L));
|
||||
I:=I+ReplacePart(LastWordStart,I-1,IntToStr(L))-1;
|
||||
end;
|
||||
end else
|
||||
if (WordS='$CONFIG') then
|
||||
begin
|
||||
if (Pass=1) then
|
||||
I:=I+ReplacePart(LastWordStart,I-1,INIPath);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,INIPath)-1;
|
||||
end else
|
||||
if (WordS='$DIR') then
|
||||
begin
|
||||
@ -1002,7 +1027,8 @@ begin
|
||||
begin
|
||||
Consume(')');
|
||||
FSplit(S,D,N,E);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,D);
|
||||
L:=Pos(':',D);if L>0 then Delete(D,1,L);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,D)-1;
|
||||
end;
|
||||
end else
|
||||
if (WordS='$DRIVE') then
|
||||
@ -1013,9 +1039,9 @@ begin
|
||||
begin
|
||||
Consume(')');
|
||||
FSplit(S,D,N,E);
|
||||
L:=Pos(':',D); if L=0 then L:=-1;
|
||||
D:=copy(D,1,L+1);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,D);
|
||||
L:=Pos(':',D);
|
||||
D:=copy(D,1,L);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,D)-1;
|
||||
end;
|
||||
end else
|
||||
if (WordS='$EDNAME') then
|
||||
@ -1024,13 +1050,13 @@ begin
|
||||
begin
|
||||
if W=nil then S:='' else
|
||||
S:=W^.Editor^.FileName;
|
||||
I:=I+ReplacePart(LastWordStart,I-1,S);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,S)-1;
|
||||
end;
|
||||
end else
|
||||
if (WordS='$EXENAME') then
|
||||
begin
|
||||
if (Pass=1) then
|
||||
I:=I+ReplacePart(LastWordStart,I-1,EXEFile);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,EXEFile)-1;
|
||||
end else
|
||||
if (WordS='$EXT') then
|
||||
begin
|
||||
@ -1040,7 +1066,7 @@ begin
|
||||
begin
|
||||
Consume(')');
|
||||
FSplit(S,D,N,E); E:=copy(E,2,255);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,E);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,E)-1;
|
||||
end;
|
||||
end else
|
||||
if (WordS='$LINE') then
|
||||
@ -1049,7 +1075,7 @@ begin
|
||||
begin
|
||||
if W=nil then L:=0 else
|
||||
L:=W^.Editor^.CurPos.Y+1;
|
||||
I:=I+ReplacePart(LastWordStart,I-1,IntToStr(L));
|
||||
I:=I+ReplacePart(LastWordStart,I-1,IntToStr(L))-1;
|
||||
end;
|
||||
end else
|
||||
if (WordS='$NAME') then
|
||||
@ -1060,7 +1086,7 @@ begin
|
||||
begin
|
||||
Consume(')');
|
||||
FSplit(S,D,N,E);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,N);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,N)-1;
|
||||
end;
|
||||
end else
|
||||
if (WordS='$NAMEEXT') then
|
||||
@ -1071,14 +1097,14 @@ begin
|
||||
begin
|
||||
Consume(')');
|
||||
FSplit(S,D,N,E);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,N+E);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,N+E)-1;
|
||||
end;
|
||||
end else
|
||||
if (WordS='$NOSWAP') then
|
||||
begin
|
||||
if (Pass=1) then
|
||||
begin
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'');
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'')-1;
|
||||
end;
|
||||
end else
|
||||
if (WordS='$DRIVE') then
|
||||
@ -1091,7 +1117,7 @@ begin
|
||||
FSplit(S,D,N,E);
|
||||
L:=Pos(':',D); if L=0 then L:=-1;
|
||||
D:=copy(D,1,L+1);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,D);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,D)-1;
|
||||
end;
|
||||
end else
|
||||
if (WordS='$PROMPT') then
|
||||
@ -1108,12 +1134,12 @@ begin
|
||||
if ExecutePromptDialog(S,S)=false then
|
||||
Err:=I
|
||||
else
|
||||
I:=I+ReplacePart(LastWordStart,I-1,S);
|
||||
I:=I+ReplacePart(LastWordStart,I-1,S)-1;
|
||||
end;
|
||||
end
|
||||
else { just prompt for parms }
|
||||
begin
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'');
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'')-1;
|
||||
if CheckOnly=false then
|
||||
begin
|
||||
S:=copy(Params,I+1,255);
|
||||
@ -1137,7 +1163,7 @@ begin
|
||||
begin
|
||||
if (Pass=2) then
|
||||
begin
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'');
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'')-1;
|
||||
Message(Application,evCommand,cmSaveAll,nil);
|
||||
end;
|
||||
end else
|
||||
@ -1145,7 +1171,7 @@ begin
|
||||
begin
|
||||
if (Pass=2) then
|
||||
begin
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'');
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'')-1;
|
||||
Message(W,evCommand,cmSave,nil);
|
||||
end;
|
||||
end else
|
||||
@ -1153,12 +1179,24 @@ begin
|
||||
begin
|
||||
if (Pass=2) then
|
||||
begin
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'');
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'')-1;
|
||||
if W<>nil then
|
||||
if W^.Editor^.SaveAsk=false then
|
||||
Err:=-1;
|
||||
end;
|
||||
end else
|
||||
if (WordS='$WRITEMSG') then
|
||||
begin
|
||||
if (Pass=2) then
|
||||
if Consume('(')=false then Err:=I else
|
||||
if ReadTill(S,')')=false then Err:=I else
|
||||
begin
|
||||
Consume(')');
|
||||
I:=I+ReplacePart(LastWordStart,I-1,'')-1;
|
||||
if CheckOnly=false then
|
||||
WriteToolMessagesToFile(S);
|
||||
end;
|
||||
end else
|
||||
if copy(WordS,1,1)='$' then
|
||||
Err:=LastWordStart;
|
||||
WordS:='';
|
||||
@ -1388,7 +1426,12 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 1999-03-08 14:58:12 peter
|
||||
Revision 1.6 1999-03-16 12:38:14 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
Revision 1.5 1999/03/08 14:58:12 peter
|
||||
+ prompt with dialogs for tools
|
||||
|
||||
Revision 1.4 1999/03/01 15:42:04 peter
|
||||
|
||||
@ -59,6 +59,7 @@ const ClipboardWindow : PClipboardWindow = nil;
|
||||
StartupOptions : longint = 0;
|
||||
LastExitCode : integer = 0;
|
||||
ASCIIChart : PFPASCIIChart = nil;
|
||||
DesktopFileFlags : longint = dfHistoryLists+dfOpenWindows;
|
||||
|
||||
ActionCommands : array[acFirstAction..acLastAction] of word =
|
||||
(cmHelpTopicSearch,cmGotoCursor,cmToggleBreakpoint,
|
||||
@ -73,7 +74,12 @@ implementation
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.12 1999-03-12 01:14:02 peter
|
||||
Revision 1.13 1999-03-16 12:38:15 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
Revision 1.12 1999/03/12 01:14:02 peter
|
||||
* flag if trytoopen should look for other extensions
|
||||
+ browser tab in the tools-compiler
|
||||
|
||||
|
||||
101
ide/text/utils/grep2msg.pas
Normal file
101
ide/text/utils/grep2msg.pas
Normal file
@ -0,0 +1,101 @@
|
||||
{************************************************}
|
||||
{ }
|
||||
{ Grep message filter example }
|
||||
{ Copyright (c) 1992 by Borland International }
|
||||
{ }
|
||||
{************************************************}
|
||||
|
||||
program Grep2Msg;
|
||||
|
||||
{ Message filters read input from the target program (in this case, GREP)
|
||||
by way of StdIn (by using Read or ReadLn), filter the input, then write
|
||||
output back to StdOut (using Write or WriteLn). The IDE takes care of
|
||||
redirecting the transfer program's output to the filter program, as well
|
||||
as redirecting the filter program's output back to the IDE itself.
|
||||
}
|
||||
|
||||
{$I-,S-}
|
||||
|
||||
var
|
||||
LineNo, E: Word;
|
||||
P1,P2: integer;
|
||||
Line: String;
|
||||
InputBuffer: array[0..4095] of Char;
|
||||
OutputBuffer: array[0..4095] of Char;
|
||||
|
||||
|
||||
{ The first data passed back to the IDE by a message filter must always
|
||||
be the string 'BI#PIP#OK', followed by a null terminator.
|
||||
}
|
||||
procedure WriteHeader;
|
||||
begin
|
||||
Write('BI#PIP#OK'#0);
|
||||
end;
|
||||
|
||||
{ The beginning of a new file is marked by a #0, the file's name, terminated
|
||||
by a #0 character.
|
||||
}
|
||||
procedure WriteNewFile(const FileName: String);
|
||||
begin
|
||||
Write(#0, FileName, #0);
|
||||
end;
|
||||
|
||||
{ Each message line begins with a #1, followed the line number (in low/high
|
||||
order), followed by the column number (in low/high order), then the
|
||||
message text itself, terminated with a #0 character.
|
||||
}
|
||||
procedure WriteMessage(Line, Col: Word; const Message: String);
|
||||
begin
|
||||
Write(#1, Chr(Lo(Line)), Chr(Hi(Line)), Chr(Lo(Col)), Chr(Hi(Col)),
|
||||
Message, #0);
|
||||
end;
|
||||
|
||||
{ The end of the input stream is marked by a #127 character }
|
||||
procedure WriteEnd;
|
||||
begin
|
||||
Write(#127);
|
||||
end;
|
||||
|
||||
function TrimLeft(S:String): String;
|
||||
var
|
||||
i: Integer;
|
||||
n: String;
|
||||
begin
|
||||
i := 1;
|
||||
while (i <= Length(s)) and (s[i] = #32) do Inc(i);
|
||||
if i <= Length(s) then
|
||||
begin
|
||||
Move(s[i], n[1], Length(s) - i + 1);
|
||||
n[0] := Char(Length(s) - i + 1);
|
||||
end
|
||||
else n[0] := #0;
|
||||
TrimLeft := n;
|
||||
end;
|
||||
|
||||
const LastFileName: string = '';
|
||||
|
||||
begin
|
||||
SetTextBuf(Input, InputBuffer);
|
||||
SetTextBuf(Output, OutputBuffer);
|
||||
WriteHeader;
|
||||
while not Eof do
|
||||
begin
|
||||
ReadLn(Line);
|
||||
if Line <> '' then
|
||||
begin
|
||||
P1:=Pos(':',Line);
|
||||
if copy(Line, 1, P1)<>LastFileName then
|
||||
begin
|
||||
LastFileName:=copy(Line,1,P1-1);
|
||||
WriteNewFile(LastFileName);
|
||||
end;
|
||||
P2:=Pos(':',copy(Line,P1+1,255));
|
||||
if P2>0 then
|
||||
begin
|
||||
Val(Copy(Line, P1+1, P2-1), LineNo, E);
|
||||
if E = 0 then WriteMessage(LineNo, 1, TrimLeft(Copy(Line, P1+1+P2, 132)));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
WriteEnd;
|
||||
end.
|
||||
28
ide/text/utils/tphc.pas
Normal file
28
ide/text/utils/tphc.pas
Normal file
@ -0,0 +1,28 @@
|
||||
uses Objects,WHelp,WTPHWriter;
|
||||
|
||||
var W: THelpFileWriter;
|
||||
HF: TOAHelpFile;
|
||||
P: PTopic;
|
||||
const Ctx = 32;
|
||||
|
||||
BEGIN
|
||||
W.Init('TEST.TPH',1);
|
||||
P:=W.CreateTopic(Ctx);
|
||||
W.AddTopicToIndex('IndexEntry',P);
|
||||
W.AddLineToTopic(P,'Hello world!');
|
||||
W.AddLineToTopic(P,'This is a '+hscLink+'sample'+hscLink+' help file.');
|
||||
W.AddLineToTopic(P,'And this is it''s 3rd line...');
|
||||
W.AddLinkToTopic(P,Ctx+1);
|
||||
P:=W.CreateTopic(Ctx+1);
|
||||
W.AddTopicToIndex('IndexEntry2',P);
|
||||
W.AddLineToTopic(P,'And this is an other topic!');
|
||||
W.AddLineToTopic(P,'>>>Back to the '+hscLink+'previous topic'+hscLink+'...');
|
||||
W.AddLinkToTopic(P,Ctx);
|
||||
W.WriteFile;
|
||||
W.Done;
|
||||
|
||||
HF.Init('TEST.TPH',1);
|
||||
HF.LoadIndex;
|
||||
P:=HF.LoadTopic(Ctx);
|
||||
HF.Done;
|
||||
END.
|
||||
@ -443,7 +443,11 @@ begin
|
||||
New(F, Init(AFileName, stOpenRead, HelpStreamBufSize));
|
||||
OK:=F<>nil;
|
||||
if OK then OK:=(F^.Status=stOK);
|
||||
if OK then begin FS:=F^.GetSize; OK:=ReadHeader; end;
|
||||
if OK then
|
||||
begin
|
||||
FS:=F^.GetSize;
|
||||
OK:=ReadHeader;
|
||||
end;
|
||||
while OK do
|
||||
begin
|
||||
L:=F^.GetPos;
|
||||
@ -478,7 +482,7 @@ var S: string;
|
||||
OK: boolean;
|
||||
begin
|
||||
F^.Seek(0);
|
||||
F^.Read(S[1],255); S[0]:=#255;
|
||||
F^.Read(S[1],128); S[0]:=#255;
|
||||
OK:=(F^.Status=stOK); P:=Pos(Signature,S);
|
||||
OK:=OK and (P>0);
|
||||
if OK then
|
||||
@ -506,7 +510,7 @@ begin
|
||||
OK:=ReadRecord(R, true);
|
||||
if OK then
|
||||
with THLPContexts(R.Data^) do
|
||||
for I:=1 to ContextCount-1 do
|
||||
for I:=1 to longint(ContextCount)-1 do
|
||||
begin
|
||||
if Topics^.Count=MaxCollectionSize then Break;
|
||||
L:=GetCtxPos(Contexts[I]);
|
||||
@ -622,11 +626,10 @@ begin
|
||||
case N of
|
||||
$00 : C:=#0;
|
||||
$01..$0D : C:=chr(Compression.CharTable[N]);
|
||||
{$ifdef FPC}
|
||||
ncRawChar : C:=chr(GetNextNibble shl 4+GetNextNibble);
|
||||
{$else}
|
||||
ncRawChar : C:=chr(GetNextNibble+GetNextNibble shl 4);
|
||||
{$endif}
|
||||
ncRawChar : begin
|
||||
I:=GetNextNibble;
|
||||
C:=chr(I+GetNextNibble shl 4);
|
||||
end;
|
||||
ncRepChar : begin
|
||||
Cnt:=2+GetNextNibble;
|
||||
C:=GetNextChar{$ifdef FPC}(){$endif};
|
||||
@ -919,7 +922,12 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 1999-03-08 14:58:19 peter
|
||||
Revision 1.11 1999-03-16 12:38:16 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
Revision 1.10 1999/03/08 14:58:19 peter
|
||||
+ prompt with dialogs for tools
|
||||
|
||||
Revision 1.9 1999/03/03 16:44:05 pierre
|
||||
|
||||
683
ide/text/wresourc.pas
Normal file
683
ide/text/wresourc.pas
Normal file
@ -0,0 +1,683 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal Integrated Development Environment
|
||||
Copyright (c) 1998 by Berczi Gabor
|
||||
|
||||
Resource File support objects and routines
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
unit WResource;
|
||||
|
||||
interface
|
||||
|
||||
uses Objects;
|
||||
|
||||
const
|
||||
TPDataBlockSignature = ord('F')+ord('B')*256;
|
||||
ResourceBlockSignature = ord('R')+ord('D')*256;
|
||||
|
||||
langDefault = 0;
|
||||
|
||||
rcBinary = 1;
|
||||
|
||||
type
|
||||
TResourceEntryHeader = packed record
|
||||
ID : longint;
|
||||
LangID : longint;
|
||||
Flags : longint;
|
||||
DataOfs: longint;
|
||||
DataLen: longint;
|
||||
end;
|
||||
|
||||
TResourceHeader = packed record
|
||||
_Class : longint;
|
||||
Flags : longint;
|
||||
NameLen : word;
|
||||
EntryCount : word;
|
||||
end;
|
||||
|
||||
TResourceFileHeader = packed record
|
||||
Signature : word;
|
||||
InfoType : word;
|
||||
InfoSize : longint;
|
||||
{ ---- }
|
||||
TableOfs : longint;
|
||||
end;
|
||||
|
||||
PResourceFile = ^TResourceFile;
|
||||
|
||||
PResourceEntry = ^TResourceEntry;
|
||||
TResourceEntry = object(TObject)
|
||||
constructor Init(AID, ALangID, AFlags, ADataLen: longint);
|
||||
private
|
||||
ID : longint;
|
||||
LangID : longint;
|
||||
Flags : longint;
|
||||
DataOfs : longint;
|
||||
DataLen : longint;
|
||||
procedure BuildHeader(var Header : TResourceEntryHeader);
|
||||
end;
|
||||
|
||||
PResourceEntryCollection = ^TResourceEntryCollection;
|
||||
TResourceEntryCollection = object(TSortedCollection)
|
||||
function At(Index: Sw_Integer): PResourceEntry;
|
||||
function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
|
||||
function SearchEntryForLang(ALangID: longint): PResourceEntry;
|
||||
end;
|
||||
|
||||
PGlobalResourceEntryCollection = ^TGlobalResourceEntryCollection;
|
||||
TGlobalResourceEntryCollection = object(TSortedCollection)
|
||||
function At(Index: Sw_Integer): PResourceEntry;
|
||||
function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
|
||||
end;
|
||||
|
||||
PResource = ^TResource;
|
||||
TResource = object(TObject)
|
||||
constructor Init(const AName: string; AClass, AFlags: longint);
|
||||
function GetName: string; virtual;
|
||||
function FirstThatEntry(Func: pointer): PResourceEntry; virtual;
|
||||
procedure ForEachEntry(Func: pointer); virtual;
|
||||
destructor Done; virtual;
|
||||
private
|
||||
Name : PString;
|
||||
_Class : longint;
|
||||
Flags : longint;
|
||||
Items : PResourceEntryCollection;
|
||||
procedure BuildHeader(var Header : TResourceHeader);
|
||||
end;
|
||||
|
||||
PResourceCollection = ^TResourceCollection;
|
||||
TResourceCollection = object(TSortedCollection)
|
||||
function At(Index: Sw_Integer): PResource;
|
||||
function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
|
||||
function SearchResourceByName(const AName: string): PResource;
|
||||
end;
|
||||
|
||||
TResourceFile = object(TObject)
|
||||
constructor Init(var RS: TStream; ALoad: boolean);
|
||||
constructor Create(var RS: TStream);
|
||||
constructor Load(var RS: TStream);
|
||||
function FirstThatResource(Func: pointer): PResource; virtual;
|
||||
procedure ForEachResource(Func: pointer); virtual;
|
||||
procedure ForEachResourceEntry(Func: pointer); virtual;
|
||||
function CreateResource(const Name: string; AClass, AFlags: longint): boolean; virtual;
|
||||
function AddResourceEntry(const ResName: string; ALangID, AFlags: longint; var Data;
|
||||
ADataSize: sw_integer): boolean; virtual;
|
||||
function AddResourceEntryFromStream(const ResName: string; ALangID, AFlags: longint;
|
||||
var Source: TStream; ADataSize: longint): boolean; virtual;
|
||||
function DeleteResourceEntry(const ResName: string; ALangID: longint): boolean; virtual;
|
||||
function DeleteResource(const ResName: string): boolean; virtual;
|
||||
procedure Flush; virtual;
|
||||
destructor Done; virtual;
|
||||
public
|
||||
BaseOfs: longint;
|
||||
function FindResource(const ResName: string): PResource;
|
||||
function FindResourceEntry(const ResName: string; ALangID: longint): PResourceEntry;
|
||||
private
|
||||
S : PStream;
|
||||
Resources : PResourceCollection;
|
||||
Entries : PGlobalResourceEntryCollection;
|
||||
Header : TResourceFileHeader;
|
||||
Modified : boolean;
|
||||
procedure UpdateBlockDatas;
|
||||
function GetNextEntryID: longint;
|
||||
function GetTotalSize(IncludeHeaders: boolean): longint;
|
||||
function CalcSizes(IncludeHeaders, UpdatePosData: boolean): longint;
|
||||
procedure AddResEntryPtr(P: PResource; E: PResourceEntry);
|
||||
procedure RemoveResEntryPtr(P: PResource; E: PResourceEntry);
|
||||
function DeleteArea(AreaStart, AreaSize, TotalSize: longint): boolean;
|
||||
procedure BuildFileHeader;
|
||||
procedure WriteHeader;
|
||||
procedure WriteResourceTable;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses CallSpec,
|
||||
WUtils;
|
||||
|
||||
function TResourceEntryCollection.At(Index: Sw_Integer): PResourceEntry;
|
||||
begin
|
||||
At:=inherited At(Index);
|
||||
end;
|
||||
|
||||
function TResourceEntryCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
|
||||
var K1: PResourceEntry absolute Key1;
|
||||
K2: PResourceEntry absolute Key2;
|
||||
Re: Sw_integer;
|
||||
begin
|
||||
if K1^.LangID<K2^.LangID then Re:=-1 else
|
||||
if K1^.LangID>K2^.LangID then Re:= 1 else
|
||||
Re:=0;
|
||||
Compare:=Re;
|
||||
end;
|
||||
|
||||
function TResourceEntryCollection.SearchEntryForLang(ALangID: longint): PResourceEntry;
|
||||
var P: PResourceEntry;
|
||||
E: TResourceEntry;
|
||||
Index: sw_integer;
|
||||
begin
|
||||
E.LangID:=ALangID;
|
||||
if Search(@E,Index)=false then P:=nil else
|
||||
P:=At(Index);
|
||||
SearchEntryForLang:=P;
|
||||
end;
|
||||
|
||||
function TGlobalResourceEntryCollection.At(Index: Sw_Integer): PResourceEntry;
|
||||
begin
|
||||
At:=inherited At(Index);
|
||||
end;
|
||||
|
||||
function TGlobalResourceEntryCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
|
||||
var K1: PResourceEntry absolute Key1;
|
||||
K2: PResourceEntry absolute Key2;
|
||||
Re: Sw_integer;
|
||||
begin
|
||||
if K1^.ID<K2^.ID then Re:=-1 else
|
||||
if K1^.ID>K2^.ID then Re:= 1 else
|
||||
Re:=0;
|
||||
Compare:=Re;
|
||||
end;
|
||||
|
||||
constructor TResourceEntry.Init(AID, ALangID, AFlags, ADataLen: longint);
|
||||
begin
|
||||
inherited Init;
|
||||
ID:=AID;
|
||||
LangID:=ALangID; Flags:=AFlags; DataLen:=ADataLen;
|
||||
end;
|
||||
|
||||
procedure TResourceEntry.BuildHeader(var Header : TResourceEntryHeader);
|
||||
begin
|
||||
FillChar(Header,SizeOf(Header),0);
|
||||
Header.ID:=ID;
|
||||
Header.LangID:=LangID;
|
||||
Header.Flags:=Flags;
|
||||
Header.DataLen:=DataLen;
|
||||
Header.DataOfs:=DataOfs;
|
||||
end;
|
||||
|
||||
constructor TResource.Init(const AName: string; AClass, AFlags: longint);
|
||||
begin
|
||||
inherited Init;
|
||||
Name:=NewStr(AName);
|
||||
_Class:=AClass;
|
||||
Flags:=AFlags;
|
||||
New(Items, Init(10,50));
|
||||
end;
|
||||
|
||||
function TResource.GetName: string;
|
||||
begin
|
||||
GetName:=GetStr(Name);
|
||||
end;
|
||||
|
||||
function TResource.FirstThatEntry(Func: pointer): PResourceEntry;
|
||||
var EP,P: PResourceEntry;
|
||||
I: sw_integer;
|
||||
begin
|
||||
P:=nil;
|
||||
for I:=0 to Items^.Count-1 do
|
||||
begin
|
||||
EP:=Items^.At(I);
|
||||
if Byte(Longint(CallPointerMethodLocal(Func,PreviousFramePointer,@Self,EP)))<>0 then
|
||||
begin
|
||||
P := EP;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
FirstThatEntry:=P;
|
||||
end;
|
||||
|
||||
procedure TResource.ForEachEntry(Func: pointer);
|
||||
var RP: PResourceEntry;
|
||||
I: sw_integer;
|
||||
begin
|
||||
for I:=0 to Items^.Count-1 do
|
||||
begin
|
||||
RP:=Items^.At(I);
|
||||
CallPointerMethodLocal(Func,PreviousFramePointer,@Self,RP);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TResource.BuildHeader(var Header : TResourceHeader);
|
||||
begin
|
||||
FillChar(Header,SizeOf(Header),0);
|
||||
Header._Class:=_Class;
|
||||
Header.Flags:=Flags;
|
||||
Header.NameLen:=length(GetName);
|
||||
Header.EntryCount:=Items^.Count;
|
||||
end;
|
||||
|
||||
destructor TResource.Done;
|
||||
begin
|
||||
inherited Done;
|
||||
if Name<>nil then DisposeStr(Name); Name:=nil;
|
||||
if Items<>nil then Dispose(Items, Done); Items:=nil;
|
||||
end;
|
||||
|
||||
function TResourceCollection.At(Index: Sw_Integer): PResource;
|
||||
begin
|
||||
At:=inherited At(Index);
|
||||
end;
|
||||
|
||||
function TResourceCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
|
||||
var K1: PResource absolute Key1;
|
||||
K2: PResource absolute Key2;
|
||||
N1,N2: string;
|
||||
Re: Sw_integer;
|
||||
begin
|
||||
N1:=UpcaseStr(K1^.GetName); N2:=UpcaseStr(K2^.GetName);
|
||||
if N1<N2 then Re:=-1 else
|
||||
if N1>N2 then Re:= 1 else
|
||||
Re:=0;
|
||||
Compare:=Re;
|
||||
end;
|
||||
|
||||
function TResourceCollection.SearchResourceByName(const AName: string): PResource;
|
||||
var P,R: PResource;
|
||||
Index: sw_integer;
|
||||
begin
|
||||
New(R, Init(AName,0,0));
|
||||
if Search(R,Index)=false then P:=nil else
|
||||
P:=At(Index);
|
||||
Dispose(R, Done);
|
||||
SearchResourceByName:=P;
|
||||
end;
|
||||
|
||||
constructor TResourceFile.Create(var RS: TStream);
|
||||
begin
|
||||
if Init(RS,false)=false then
|
||||
Fail;
|
||||
end;
|
||||
|
||||
constructor TResourceFile.Load(var RS: TStream);
|
||||
begin
|
||||
if Init(RS,true)=false then
|
||||
Fail;
|
||||
end;
|
||||
|
||||
constructor TResourceFile.Init(var RS: TStream; ALoad: boolean);
|
||||
var OK: boolean;
|
||||
RH: TResourceHeader;
|
||||
REH: TResourceEntryHeader;
|
||||
EndPos,I: longint;
|
||||
P: PResource;
|
||||
E: PResourceEntry;
|
||||
St: string;
|
||||
begin
|
||||
inherited Init;
|
||||
S:=@RS;
|
||||
New(Resources, Init(100, 1000));
|
||||
New(Entries, Init(500,2000));
|
||||
OK:=true;
|
||||
if ALoad=false then
|
||||
Modified:=true
|
||||
else
|
||||
begin
|
||||
BaseOfs:=S^.GetPos;
|
||||
S^.Read(Header,SizeOf(Header));
|
||||
OK:=(S^.Status=stOK) and
|
||||
(Header.Signature=TPDataBlockSignature) and
|
||||
(Header.InfoType=ResourceBlockSignature);
|
||||
if OK then begin S^.Seek(BaseOfs+Header.TableOfs); OK:=S^.Status=stOK; end;
|
||||
EndPos:=BaseOfs+Header.InfoSize;
|
||||
if OK then
|
||||
while OK and (S^.GetPos<EndPos) do
|
||||
begin
|
||||
S^.Read(RH,SizeOf(RH)); OK:=(S^.Status=stOK);
|
||||
if OK then begin St[0]:=chr(RH.NameLen); S^.Read(St[1],RH.NameLen); OK:=(S^.Status=stOK); end;
|
||||
if OK then
|
||||
begin
|
||||
New(P, Init(St,RH._Class,RH.Flags));
|
||||
Resources^.Insert(P);
|
||||
end;
|
||||
I:=0;
|
||||
while OK and (I<RH.EntryCount) do
|
||||
begin
|
||||
S^.Read(REH,SizeOf(REH)); OK:=(S^.Status=stOK);
|
||||
if OK then
|
||||
begin
|
||||
New(E, Init(REH.ID,REH.LangID,REH.Flags,REH.DataLen));
|
||||
AddResEntryPtr(P,E);
|
||||
end;
|
||||
if OK then Inc(I);
|
||||
end;
|
||||
if OK then UpdateBlockDatas;
|
||||
end;
|
||||
end;
|
||||
if OK=false then
|
||||
begin
|
||||
Done;
|
||||
Fail;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TResourceFile.FirstThatResource(Func: pointer): PResource;
|
||||
var RP,P: PResource;
|
||||
I: sw_integer;
|
||||
begin
|
||||
P:=nil;
|
||||
for I:=0 to Resources^.Count-1 do
|
||||
begin
|
||||
RP:=Resources^.At(I);
|
||||
if Byte(Longint(CallPointerMethodLocal(Func,PreviousFramePointer,@Self,RP)))<>0 then
|
||||
begin
|
||||
P := RP;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
FirstThatResource:=P;
|
||||
end;
|
||||
|
||||
procedure TResourceFile.ForEachResource(Func: pointer);
|
||||
var RP: PResource;
|
||||
I: sw_integer;
|
||||
begin
|
||||
for I:=0 to Resources^.Count-1 do
|
||||
begin
|
||||
RP:=Resources^.At(I);
|
||||
CallPointerMethodLocal(Func,PreviousFramePointer,@Self,RP);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TResourceFile.ForEachResourceEntry(Func: pointer);
|
||||
var E: PResourceEntry;
|
||||
I: sw_integer;
|
||||
begin
|
||||
for I:=0 to Entries^.Count-1 do
|
||||
begin
|
||||
E:=Entries^.At(I);
|
||||
CallPointerMethodLocal(Func,PreviousFramePointer,@Self,E);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TResourceFile.CreateResource(const Name: string; AClass, AFlags: longint): boolean;
|
||||
var OK: boolean;
|
||||
P: PResource;
|
||||
begin
|
||||
OK:=FindResource(Name)=nil;
|
||||
if OK then
|
||||
begin
|
||||
New(P, Init(Name,AClass,AFlags));
|
||||
Resources^.Insert(P);
|
||||
Modified:=true;
|
||||
end;
|
||||
CreateResource:=OK;
|
||||
end;
|
||||
|
||||
function TResourceFile.AddResourceEntry(const ResName: string; ALangID, AFlags: longint; var Data;
|
||||
ADataSize: sw_integer): boolean;
|
||||
const BlockSize = 4096;
|
||||
var OK: boolean;
|
||||
P: PResource;
|
||||
E: PResourceEntry;
|
||||
RemSize,CurOfs,FragSize: longint;
|
||||
begin
|
||||
P:=FindResource(ResName);
|
||||
OK:=P<>nil;
|
||||
if OK then
|
||||
OK:=(P^.Items^.SearchEntryForLang(ALangID)=nil);
|
||||
if OK then
|
||||
begin
|
||||
New(E, Init(GetNextEntryID,ALangID, AFlags, ADataSize));
|
||||
AddResEntryPtr(P,E);
|
||||
UpdateBlockDatas;
|
||||
RemSize:=ADataSize; CurOfs:=0;
|
||||
S^.Seek(BaseOfs+E^.DataOfs);
|
||||
while (RemSize>0) do
|
||||
begin
|
||||
FragSize:=Min(RemSize,BlockSize);
|
||||
S^.Write(PByteArray(@Data)^[CurOfs],FragSize);
|
||||
Dec(RemSize,FragSize); Inc(CurOfs,FragSize);
|
||||
end;
|
||||
Modified:=true;
|
||||
end;
|
||||
AddResourceEntry:=OK;
|
||||
end;
|
||||
|
||||
function TResourceFile.AddResourceEntryFromStream(const ResName: string; ALangID, AFlags: longint;
|
||||
var Source: TStream; ADataSize: longint): boolean;
|
||||
const BufSize = 4096;
|
||||
var OK: boolean;
|
||||
P: PResource;
|
||||
E: PResourceEntry;
|
||||
RemSize,FragSize: longint;
|
||||
Buf: pointer;
|
||||
begin
|
||||
P:=FindResource(ResName);
|
||||
OK:=P<>nil;
|
||||
if OK then
|
||||
OK:=(P^.Items^.SearchEntryForLang(ALangID)=nil);
|
||||
if OK then
|
||||
begin
|
||||
New(E, Init(GetNextEntryID, ALangID, AFlags, ADataSize));
|
||||
AddResEntryPtr(P,E);
|
||||
UpdateBlockDatas;
|
||||
GetMem(Buf,BufSize);
|
||||
RemSize:=ADataSize;
|
||||
S^.Seek(BaseOfs+E^.DataOfs);
|
||||
while (RemSize>0) do
|
||||
begin
|
||||
FragSize:=Min(RemSize,BufSize);
|
||||
Source.Read(Buf^,FragSize);
|
||||
S^.Write(Buf^,FragSize);
|
||||
Dec(RemSize,FragSize);
|
||||
end;
|
||||
FreeMem(Buf,BufSize);
|
||||
Modified:=true;
|
||||
end;
|
||||
AddResourceEntryFromStream:=OK;
|
||||
end;
|
||||
|
||||
function TResourceFile.DeleteResourceEntry(const ResName: string; ALangID: longint): boolean;
|
||||
var E: PResourceEntry;
|
||||
P: PResource;
|
||||
OK: boolean;
|
||||
begin
|
||||
P:=FindResource(ResName);
|
||||
OK:=P<>nil;
|
||||
if OK then E:=P^.Items^.SearchEntryForLang(ALangID);
|
||||
OK:=OK and (E<>nil);
|
||||
if OK then
|
||||
begin
|
||||
OK:=DeleteArea(E^.DataOfs,E^.DataLen,GetTotalSize(false));
|
||||
if OK then begin RemoveResEntryPtr(P,E); Dispose(E, Done); end;
|
||||
Modified:=true;
|
||||
end;
|
||||
DeleteResourceEntry:=OK;
|
||||
end;
|
||||
|
||||
function TResourceFile.DeleteResource(const ResName: string): boolean;
|
||||
var P: PResource;
|
||||
E: PResourceEntry;
|
||||
OK: boolean;
|
||||
begin
|
||||
P:=FindResource(ResName);
|
||||
OK:=P<>nil;
|
||||
if P<>nil then
|
||||
begin
|
||||
while OK and (P^.Items^.Count>0) do
|
||||
begin
|
||||
E:=P^.Items^.At(P^.Items^.Count-1);
|
||||
OK:=OK and DeleteResourceEntry(ResName,E^.LangID);
|
||||
end;
|
||||
Modified:=true;
|
||||
end;
|
||||
if OK then Resources^.Free(P);
|
||||
DeleteResource:=OK;
|
||||
end;
|
||||
|
||||
function TResourceFile.FindResource(const ResName: string): PResource;
|
||||
begin
|
||||
FindResource:=Resources^.SearchResourceByName(ResName);
|
||||
end;
|
||||
|
||||
function TResourceFile.FindResourceEntry(const ResName: string; ALangID: longint): PResourceEntry;
|
||||
var P: PResource;
|
||||
E: PResourceEntry;
|
||||
begin
|
||||
E:=nil;
|
||||
P:=FindResource(ResName);
|
||||
if P<>nil then
|
||||
E:=P^.Items^.SearchEntryForLang(ALangID);
|
||||
FindResourceEntry:=E;
|
||||
end;
|
||||
|
||||
procedure TResourceFile.Flush;
|
||||
begin
|
||||
if Modified=false then Exit;
|
||||
BuildFileHeader;
|
||||
S^.Seek(BaseOfs);
|
||||
WriteHeader;
|
||||
S^.Seek(BaseOfs+Header.TableOfs);
|
||||
WriteResourceTable;
|
||||
S^.Truncate;
|
||||
Modified:=false;
|
||||
end;
|
||||
|
||||
procedure TResourceFile.BuildFileHeader;
|
||||
begin
|
||||
FillChar(Header,SizeOf(Header),0);
|
||||
with Header do
|
||||
begin
|
||||
Signature:=TPDataBlockSignature;
|
||||
InfoType:=ResourceBlockSignature;
|
||||
InfoSize:=GetTotalSize(true);
|
||||
TableOfs:=GetTotalSize(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TResourceFile.WriteHeader;
|
||||
begin
|
||||
S^.Write(Header,SizeOf(Header));
|
||||
end;
|
||||
|
||||
procedure TResourceFile.WriteResourceTable;
|
||||
var RH: TResourceHeader;
|
||||
REH: TResourceEntryHeader;
|
||||
procedure WriteResource(P: PResource); {$ifndef FPC}far;{$endif}
|
||||
procedure WriteResourceEntry(P: PResourceEntry); {$ifndef FPC}far;{$endif}
|
||||
begin
|
||||
P^.BuildHeader(REH);
|
||||
S^.Write(REH,SizeOf(REH));
|
||||
end;
|
||||
var N: string;
|
||||
begin
|
||||
if P^.Items^.Count=0 then Exit; { do not store resources with no entries }
|
||||
P^.BuildHeader(RH);
|
||||
S^.Write(RH,SizeOf(RH));
|
||||
N:=P^.GetName;
|
||||
S^.Write(N[1],length(N));
|
||||
P^.ForEachEntry(@WriteResourceEntry);
|
||||
end;
|
||||
begin
|
||||
ForEachResource(@WriteResource);
|
||||
end;
|
||||
|
||||
procedure TResourceFile.UpdateBlockDatas;
|
||||
begin
|
||||
CalcSizes(false,true);
|
||||
end;
|
||||
|
||||
function TResourceFile.GetTotalSize(IncludeHeaders: boolean): longint;
|
||||
begin
|
||||
GetTotalSize:=CalcSizes(IncludeHeaders,false);
|
||||
end;
|
||||
|
||||
function TResourceFile.CalcSizes(IncludeHeaders, UpdatePosData: boolean): longint;
|
||||
var RH : TResourceHeader;
|
||||
REH : TResourceEntryHeader;
|
||||
Size: longint;
|
||||
procedure AddResourceEntrySize(P: PResourceEntry); {$ifndef FPC}far;{$endif}
|
||||
begin
|
||||
if UpdatePosData then P^.DataOfs:=Size;
|
||||
P^.BuildHeader(REH);
|
||||
Inc(Size,REH.DataLen);
|
||||
end;
|
||||
begin
|
||||
Size:=0;
|
||||
Inc(Size,SizeOf(Header)); { this is on start so we always include it }
|
||||
ForEachResourceEntry(@AddResourceEntrySize);
|
||||
if IncludeHeaders then
|
||||
begin
|
||||
Inc(Size,SizeOf(RH)*Resources^.Count);
|
||||
Inc(Size,SizeOf(REH)*Entries^.Count);
|
||||
end;
|
||||
CalcSizes:=Size;
|
||||
end;
|
||||
|
||||
function TResourceFile.DeleteArea(AreaStart, AreaSize, TotalSize: longint): boolean;
|
||||
const BufSize = 4096;
|
||||
var RemSize,FragSize,CurOfs: longint;
|
||||
Buf: pointer;
|
||||
OK: boolean;
|
||||
begin
|
||||
GetMem(Buf,BufSize);
|
||||
RemSize:=TotalSize-(AreaStart+AreaSize); CurOfs:=0;
|
||||
OK:=RemSize>=0;
|
||||
while (RemSize>0) do
|
||||
begin
|
||||
FragSize:=Min(RemSize,BufSize);
|
||||
S^.Seek(BaseOfs+AreaStart+AreaSize+CurOfs);
|
||||
S^.Read(Buf^,BufSize);
|
||||
OK:=OK and (S^.Status=stOK);
|
||||
if OK then
|
||||
begin
|
||||
S^.Seek(BaseOfs+AreaStart+CurOfs);
|
||||
S^.Write(Buf^,BufSize);
|
||||
OK:=OK and (S^.Status=stOK);
|
||||
end;
|
||||
Inc(CurOfs,FragSize); Dec(RemSize,FragSize);
|
||||
end;
|
||||
FreeMem(Buf,BufSize);
|
||||
DeleteArea:=OK;
|
||||
end;
|
||||
|
||||
procedure TResourceFile.AddResEntryPtr(P: PResource; E: PResourceEntry);
|
||||
begin
|
||||
if (P=nil) or (E=nil) then Exit;
|
||||
P^.Items^.Insert(E);
|
||||
Entries^.Insert(E);
|
||||
end;
|
||||
|
||||
procedure TResourceFile.RemoveResEntryPtr(P: PResource; E: PResourceEntry);
|
||||
begin
|
||||
if (P=nil) or (E=nil) then Exit;
|
||||
Entries^.Delete(E);
|
||||
P^.Items^.Delete(E);
|
||||
end;
|
||||
|
||||
function TResourceFile.GetNextEntryID: longint;
|
||||
var ID: longint;
|
||||
begin
|
||||
if Entries^.Count=0 then ID:=1 else
|
||||
ID:=Entries^.At(Entries^.Count-1)^.ID+1;
|
||||
GetNextEntryID:=ID;
|
||||
end;
|
||||
|
||||
destructor TResourceFile.Done;
|
||||
begin
|
||||
Flush;
|
||||
inherited Done;
|
||||
if Resources<>nil then Dispose(Resources, Done); Resources:=nil;
|
||||
if Entries<>nil then
|
||||
begin Entries^.DeleteAll; Dispose(Entries, Done); Entries:=nil; end;
|
||||
end;
|
||||
|
||||
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-03-16 12:38:18 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
}
|
||||
|
||||
283
ide/text/wtphwrit.pas
Normal file
283
ide/text/wtphwrit.pas
Normal file
@ -0,0 +1,283 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal Integrated Development Environment
|
||||
Copyright (c) 1998 by Berczi Gabor
|
||||
|
||||
Routines to create .tph files
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
unit WTPHWriter;
|
||||
|
||||
interface
|
||||
|
||||
uses Objects,WHelp;
|
||||
|
||||
const
|
||||
HelpStamp = 'TURBO PASCAL HelpFile.';
|
||||
|
||||
DefFormatVersion = $34;
|
||||
|
||||
type
|
||||
PHelpFileWriter = ^THelpFileWriter;
|
||||
THelpFileWriter = object(TOAHelpFile)
|
||||
constructor Init(AFileName: string; AID: word);
|
||||
function CreateTopic(HelpCtx: THelpCtx): PTopic; virtual;
|
||||
procedure AddTopicToIndex(IndexTag: string; P: PTopic); virtual;
|
||||
procedure AddLineToTopic(P: PTopic; Line: string); virtual;
|
||||
procedure AddLinkToTopic(P: PTopic; AHelpCtx: THelpCtx);
|
||||
procedure AddIndexEntry(Tag: string; P: PTopic); virtual;
|
||||
function WriteFile: boolean; virtual;
|
||||
destructor Done; virtual;
|
||||
private
|
||||
procedure CompleteContextNo;
|
||||
procedure CalcTopicOfs;
|
||||
procedure WriteHeader(var S: TStream);
|
||||
procedure WriteCompressionRecord(var S: TStream);
|
||||
procedure WriteContextTable(var S: TStream);
|
||||
procedure WriteIndexTable(var S: TStream);
|
||||
procedure WriteTopic(var S: TStream; T: PTopic);
|
||||
procedure WriteRecord(var S: TStream; RecType: byte; var Buf; Size: word);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor THelpFileWriter.Init(AFileName: string; AID: word);
|
||||
var OK: boolean;
|
||||
begin
|
||||
THelpFile.Init(AID);
|
||||
New(F, Init(AFileName, stCreate, HelpStreamBufSize));
|
||||
OK:=F<>nil;
|
||||
if OK then OK:=(F^.Status=stOK);
|
||||
if OK=false then Fail;
|
||||
end;
|
||||
|
||||
function THelpFileWriter.CreateTopic(HelpCtx: THelpCtx): PTopic;
|
||||
var P: PTopic;
|
||||
begin
|
||||
if (HelpCtx<>0) and (SearchTopic(HelpCtx)<>nil) then
|
||||
P:=nil
|
||||
else
|
||||
begin
|
||||
P:=NewTopic(ID,HelpCtx,0,'');
|
||||
Topics^.Insert(P);
|
||||
end;
|
||||
CreateTopic:=P;
|
||||
end;
|
||||
|
||||
procedure THelpFileWriter.AddTopicToIndex(IndexTag: string; P: PTopic);
|
||||
begin
|
||||
IndexEntries^.Insert(NewIndexEntry(IndexTag,P^.FileID,P^.HelpCtx));
|
||||
end;
|
||||
|
||||
procedure THelpFileWriter.AddLineToTopic(P: PTopic; Line: string);
|
||||
var OldText: pointer;
|
||||
OldSize: word;
|
||||
begin
|
||||
if P=nil then Exit;
|
||||
OldText:=P^.Text; OldSize:=P^.TextSize;
|
||||
Inc(P^.TextSize,length(Line)+1);
|
||||
GetMem(P^.Text,P^.TextSize);
|
||||
if OldText<>nil then Move(OldText^,P^.Text^,OldSize);
|
||||
Move(Line[1],P^.Text^[OldSize],length(Line));
|
||||
P^.Text^[OldSize+length(Line)]:=0;
|
||||
if OldText<>nil then FreeMem(OldText,OldSize);
|
||||
end;
|
||||
|
||||
procedure THelpFileWriter.AddLinkToTopic(P: PTopic; AHelpCtx: THelpCtx);
|
||||
var OldEntries: pointer;
|
||||
OldCount : word;
|
||||
OldSize : word;
|
||||
begin
|
||||
if P=nil then Exit;
|
||||
OldEntries:=P^.Links; OldCount:=P^.LinkCount; OldSize:=P^.LinkSize;
|
||||
Inc(P^.LinkCount);
|
||||
GetMem(P^.Links,P^.LinkSize);
|
||||
if OldEntries<>nil then Move(OldEntries^,P^.Links^,OldSize);
|
||||
with P^.Links^[P^.LinkCount-1] do
|
||||
begin
|
||||
FileID:=ID;
|
||||
Context:=AHelpCtx;
|
||||
end;
|
||||
if OldEntries<>nil then FreeMem(OldEntries,OldSize);
|
||||
end;
|
||||
|
||||
procedure THelpFileWriter.AddIndexEntry(Tag: string; P: PTopic);
|
||||
begin
|
||||
if P=nil then Exit;
|
||||
IndexEntries^.Insert(NewIndexEntry(Tag,P^.FileID,P^.HelpCtx));
|
||||
end;
|
||||
|
||||
function THelpFileWriter.WriteFile: boolean;
|
||||
var I: sw_integer;
|
||||
CtxStart: longint;
|
||||
begin
|
||||
CompleteContextNo;
|
||||
CalcTopicOfs;
|
||||
|
||||
WriteHeader(F^);
|
||||
WriteCompressionRecord(F^);
|
||||
CtxStart:=F^.GetPos;
|
||||
WriteContextTable(F^);
|
||||
WriteIndexTable(F^);
|
||||
for I:=0 to Topics^.Count-1 do
|
||||
begin
|
||||
WriteTopic(F^,Topics^.At(I));
|
||||
end;
|
||||
F^.Seek(CtxStart);
|
||||
WriteContextTable(F^);
|
||||
end;
|
||||
|
||||
procedure THelpFileWriter.WriteHeader(var S: TStream);
|
||||
var St: string;
|
||||
begin
|
||||
Version.FormatVersion:=DefFormatVersion;
|
||||
|
||||
St:=HelpStamp+#0#$1a;
|
||||
F^.Write(St[1],length(St));
|
||||
St:=Signature;
|
||||
F^.Write(St[1],length(St));
|
||||
F^.Write(Version,SizeOf(Version));
|
||||
|
||||
WriteRecord(F^,rtFileHeader,Header,SizeOf(Header));
|
||||
end;
|
||||
|
||||
procedure THelpFileWriter.WriteCompressionRecord(var S: TStream);
|
||||
var CR: THLPCompression;
|
||||
begin
|
||||
FillChar(CR,SizeOf(CR),0);
|
||||
WriteRecord(F^,rtCompression,CR,SizeOf(CR));
|
||||
end;
|
||||
|
||||
procedure THelpFileWriter.WriteIndexTable(var S: TStream);
|
||||
const BufSize = 65000;
|
||||
var P: ^THLPIndexTable;
|
||||
TableSize: word;
|
||||
procedure AddByte(B: byte);
|
||||
begin
|
||||
PByteArray(@P^.Entries)^[TableSize]:=B;
|
||||
Inc(TableSize);
|
||||
end;
|
||||
procedure AddEntry(Tag: string; HelpCtx: word);
|
||||
var Len,I: byte;
|
||||
begin
|
||||
Len:=length(Tag); if Len>31 then Len:=31;
|
||||
AddByte(Len);
|
||||
for I:=1 to Len do
|
||||
AddByte(ord(Tag[I]));
|
||||
AddByte(Lo(HelpCtx)); AddByte(Hi(HelpCtx));
|
||||
end;
|
||||
var I: sw_integer;
|
||||
begin
|
||||
if IndexEntries^.Count=0 then Exit;
|
||||
GetMem(P,BufSize);
|
||||
|
||||
TableSize:=0;
|
||||
P^.IndexCount:=IndexEntries^.Count;
|
||||
for I:=0 to IndexEntries^.Count-1 do
|
||||
with IndexEntries^.At(I)^ do
|
||||
AddEntry(Tag^,HelpCtx);
|
||||
Inc(TableSize,SizeOf(P^.IndexCount));
|
||||
WriteRecord(F^,rtIndex,P^,TableSize);
|
||||
|
||||
FreeMem(P,BufSize);
|
||||
end;
|
||||
|
||||
procedure THelpFileWriter.WriteContextTable(var S: TStream);
|
||||
var Ctxs: ^THLPContexts;
|
||||
CtxSize,I: word;
|
||||
T: PTopic;
|
||||
MaxCtx: longint;
|
||||
begin
|
||||
if Topics^.Count=0 then MaxCtx:=1 else
|
||||
MaxCtx:=Topics^.At(Topics^.Count-1)^.HelpCtx;
|
||||
CtxSize:=SizeOf(Ctxs^.ContextCount)+SizeOf(Ctxs^.Contexts[0])*(MaxCtx+1);
|
||||
GetMem(Ctxs,CtxSize); FillChar(Ctxs^,CtxSize,0);
|
||||
Ctxs^.ContextCount:=MaxCtx+1;
|
||||
for I:=1 to Topics^.Count do
|
||||
begin
|
||||
T:=Topics^.At(I-1);
|
||||
with Ctxs^.Contexts[T^.HelpCtx] do
|
||||
begin
|
||||
LoW:=(T^.FileOfs and $ffff);
|
||||
HiB:=(T^.FileOfs shr 16) and $ff;
|
||||
end;
|
||||
end;
|
||||
WriteRecord(F^,rtContext,Ctxs^,CtxSize);
|
||||
FreeMem(Ctxs,CtxSize);
|
||||
end;
|
||||
|
||||
procedure THelpFileWriter.WriteTopic(var S: TStream; T: PTopic);
|
||||
var TextBuf: PByteArray;
|
||||
TextSize: word;
|
||||
KWBuf: ^THLPKeywordRecord;
|
||||
I,KWBufSize: word;
|
||||
begin
|
||||
T^.FileOfs:=S.GetPos;
|
||||
TextBuf:=T^.Text; TextSize:=T^.TextSize;
|
||||
WriteRecord(F^,rtText,TextBuf^,TextSize);
|
||||
{ write keyword record here }
|
||||
KWBufSize:=SizeOf(KWBuf^)+SizeOf(KWBuf^.Keywords[0])*T^.LinkCount;
|
||||
GetMem(KWBuf,KWBufSize); FillChar(KWBuf^,KWBufSize,0);
|
||||
KWBuf^.KeywordCount:=T^.LinkCount;
|
||||
for I:=0 to T^.LinkCount-1 do
|
||||
KWBuf^.Keywords[I].kwContext:=T^.Links^[I].Context;
|
||||
WriteRecord(F^,rtKeyword,KWBuf^,KWBufSize);
|
||||
FreeMem(KWBuf,KWBufSize);
|
||||
end;
|
||||
|
||||
procedure THelpFileWriter.CompleteContextNo;
|
||||
var P: PTopic;
|
||||
NextTopicID: THelpCtx;
|
||||
function SearchNextFreeTopicID: THelpCtx;
|
||||
begin
|
||||
while Topics^.SearchTopic(NextTopicID)<>nil do
|
||||
Inc(NextTopicID);
|
||||
SearchNextFreeTopicID:=NextTopicID;
|
||||
end;
|
||||
begin
|
||||
NextTopicID:=1;
|
||||
repeat
|
||||
P:=Topics^.SearchTopic(0);
|
||||
if P<>nil then
|
||||
begin
|
||||
Topics^.Delete(P);
|
||||
P^.HelpCtx:=SearchNextFreeTopicID;
|
||||
Topics^.Insert(P);
|
||||
end;
|
||||
until P=nil;
|
||||
end;
|
||||
|
||||
procedure THelpFileWriter.CalcTopicOfs;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure THelpFileWriter.WriteRecord(var S: TStream; RecType: byte; var Buf; Size: word);
|
||||
var RH: THLPRecordHeader;
|
||||
begin
|
||||
RH.RecType:=RecType; RH.RecLength:=Size;
|
||||
S.Write(RH,SizeOf(RH));
|
||||
S.Write(Buf,Size);
|
||||
end;
|
||||
|
||||
destructor THelpFileWriter.Done;
|
||||
begin
|
||||
inherited Done;
|
||||
end;
|
||||
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-03-16 12:38:18 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user