fpc/ide/text/fpdesk.pas
2000-02-07 12:03:48 +00:00

761 lines
21 KiB
ObjectPascal

{
$Id$
This file is part of the Free Pascal Integrated Development Environment
Copyright (c) 1998 by Berczi Gabor
Desktop loading/saving 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 FPDesk;
interface
const
DesktopVersion = $0006; { <- if you change any Load&Store methods,
default object properties (Options,State)
then you should also change this }
ResDesktopFlags = 'FLAGS';
ResVideo = 'VIDEOMODE';
ResHistory = 'HISTORY';
ResClipboard = 'CLIPBOARD';
ResWatches = 'WATCHES';
ResBreakpoints = 'BREAKPOINTS';
ResDesktop = 'DESKTOP';
ResSymbols = 'SYMBOLS';
ResCodeComplete = 'CODECOMPLETE';
ResCodeTemplates = 'CODETEMPLATES';
procedure InitDesktopFile;
function LoadDesktop: boolean;
function SaveDesktop: boolean;
procedure DoneDesktopFile;
function WriteSymbolsFile(const filename : string): boolean;
function ReadSymbolsFile(const filename : string): boolean;
implementation
uses Dos,
Objects,Drivers,Video,
Views,App,HistList,BrowCol,
WResource,WViews,WEditor,
WUtils,
{$ifndef NODEBUG}
fpdebug,
{$endif ndef NODEBUG}
FPConst,FPVars,FPUtils,FPViews,FPCompile,FPTools,FPHelp,
FPCodCmp,FPCodTmp;
procedure InitDesktopFile;
begin
if DesktopLocation=dlCurrentDir then
DesktopPath:=FExpand(DesktopName)
else
DesktopPath:=FExpand(DirOf(INIPath)+DesktopName);
end;
procedure DoneDesktopFile;
begin
end;
function ReadHistory(F: PResourceFile): boolean;
var S: PMemoryStream;
OK: boolean;
begin
PushStatus('Reading history...');
New(S, Init(32*1024,4096));
OK:=F^.ReadResourceEntryToStream(resHistory,langDefault,S^);
S^.Seek(0);
if OK then
LoadHistory(S^);
Dispose(S, Done);
if OK=false then
ErrorBox('Error loading history',nil);
PopStatus;
ReadHistory:=OK;
end;
function WriteHistory(F: PResourceFile): boolean;
var S: PMemoryStream;
OK: boolean;
begin
PushStatus('Storing history...');
New(S, Init(10*1024,4096));
StoreHistory(S^);
S^.Seek(0);
F^.CreateResource(resHistory,rcBinary,0);
OK:=F^.AddResourceEntryFromStream(resHistory,langDefault,0,S^,S^.GetSize);
Dispose(S, Done);
if OK=false then
ErrorBox('Error storing history',nil);
PopStatus;
WriteHistory:=OK;
end;
(*function ReadClipboard(F: PResourceFile): boolean;
begin
ReadClipboard:=true;
end;
function WriteClipboard(F: PResourceFile): boolean;
var S: PMemoryStream;
begin
if Assigned(Clipboard) then
begin
PushStatus('Storing clipboard content...');
New(S, Init(10*1024,4096));
Clipboard^.SaveToStream(S^);
S^.Seek(0);
F^.CreateResource(resClipboard,rcBinary,0);
F^.AddResourceEntryFromStream(resClipboard,langDefault,0,S^,S^.GetSize);
Dispose(S, Done);
PopStatus;
end;
WriteClipboard:=true;
end;*)
function ReadWatches(F: PResourceFile): boolean;
{$ifndef NODEBUG}
var S: PMemoryStream;
OK: boolean;
OWC : PWatchesCollection;
{$endif}
begin
{$ifndef NODEBUG}
PushStatus('Reading watches...');
New(S, Init(32*1024,4096));
OK:=F^.ReadResourceEntryToStream(resWatches,langDefault,S^);
S^.Seek(0);
if OK then
begin
OWC:=WatchesCollection;
WatchesCollection:=PWatchesCollection(S^.Get);
OK:=(S^.Status=stOK);
if OK and assigned(OWC) and assigned(WatchesCollection) then
Dispose(OWC,Done)
else if assigned(OWC) then
WatchesCollection:=OWC;
end;
if OK=false then
ErrorBox('Error loading watches',nil);
ReadWatches:=OK;
Dispose(S, Done);
PopStatus;
{$else NODEBUG}
ReadWatches:=true;
{$endif NODEBUG}
end;
function WriteWatches(F: PResourceFile): boolean;
var
S : PMemoryStream;
OK : boolean;
begin
{$ifndef NODEBUG}
if not assigned(WatchesCollection) then
{$endif NODEBUG}
WriteWatches:=true
{$ifndef NODEBUG}
else
begin
PushStatus('Storing watches...');
New(S, Init(30*1024,4096));
S^.Put(WatchesCollection);
S^.Seek(0);
F^.CreateResource(resWatches,rcBinary,0);
OK:=F^.AddResourceEntryFromStream(resWatches,langDefault,0,S^,S^.GetSize);
Dispose(S, Done);
if OK=false then
ErrorBox('Error storing watches',nil);
PopStatus;
WriteWatches:=OK;
end;
{$endif NODEBUG}
end;
function ReadBreakpoints(F: PResourceFile): boolean;
{$ifndef NODEBUG}
var S: PMemoryStream;
OK: boolean;
OBC : PBreakpointCollection;
{$endif}
begin
{$ifndef NODEBUG}
PushStatus('Reading breakpoints...');
New(S, Init(32*1024,4096));
OK:=F^.ReadResourceEntryToStream(resBreakpoints,langDefault,S^);
S^.Seek(0);
if OK then
begin
OBC:=BreakpointsCollection;
BreakpointsCollection:=PBreakpointCollection(S^.get);
OK:=(S^.Status=stOK);
If OK and assigned(OBC) and assigned(BreakpointsCollection) then
Begin
Dispose(OBC,Done);
BreakpointsCollection^.ShowAllBreakpoints;
end
else if assigned(OBC) then
BreakpointsCollection:=OBC;
end;
if OK=false then
ErrorBox('Error loading breakpoints',nil);
ReadBreakpoints:=OK;
Dispose(S, Done);
PopStatus;
{$else NODEBUG}
ReadBreakpoints:=true;
{$endif NODEBUG}
end;
function WriteBreakpoints(F: PResourceFile): boolean;
var
S : PMemoryStream;
OK : boolean;
begin
{$ifndef NODEBUG}
if not assigned(BreakpointsCollection) then
{$endif NODEBUG}
WriteBreakPoints:=true
{$ifndef NODEBUG}
else
begin
PushStatus('Storing breakpoints...');
New(S, Init(30*1024,4096));
BreakpointsCollection^.Store(S^);
S^.Seek(0);
F^.CreateResource(resBreakpoints,rcBinary,0);
OK:=F^.AddResourceEntryFromStream(resBreakpoints,langDefault,0,S^,S^.GetSize);
Dispose(S, Done);
if OK=false then
ErrorBox('Error storing breakpoints',nil);
WriteBreakPoints:=OK;
PopStatus;
end;
{$endif NODEBUG}
end;
function ReadOpenWindows(F: PResourceFile): boolean;
var S: PMemoryStream;
TempDesk: PFPDesktop;
OK: boolean;
R : TRect;
W: word;
begin
PushStatus('Reading desktop contents...');
New(S, Init(32*1024,4096));
OK:=F^.ReadResourceEntryToStream(resDesktop,langDefault,S^);
S^.Seek(0);
if OK then
begin
S^.Read(W,SizeOf(W));
OK:=(W=DesktopVersion);
if OK=false then
ErrorBox('Invalid desktop version. Desktop layout lost.',nil);
end;
if OK then
begin
TempDesk:=PFPDesktop(S^.Get);
OK:=Assigned(TempDesk);
if OK then
begin
Dispose(Desktop, Done);
Desktop:=TempDesk;
with Desktop^ do
begin
GetSubViewPtr(S^,CompilerMessageWindow);
GetSubViewPtr(S^,CompilerStatusDialog);
GetSubViewPtr(S^,ClipboardWindow);
if Assigned(ClipboardWindow) then Clipboard:=ClipboardWindow^.Editor;
GetSubViewPtr(S^,CalcWindow);
GetSubViewPtr(S^,ProgramInfoWindow);
GetSubViewPtr(S^,GDBWindow);
GetSubViewPtr(S^,BreakpointsWindow);
GetSubViewPtr(S^,WatchesWindow);
GetSubViewPtr(S^,UserScreenWindow);
GetSubViewPtr(S^,ASCIIChart);
GetSubViewPtr(S^,MessagesWindow); LastToolMessageFocused:=nil;
end;
Application^.GetExtent(R);
Inc(R.A.Y);Dec(R.B.Y);
DeskTop^.Locate(R);
Application^.Insert(Desktop);
Desktop^.ReDraw;
Message(Application,evBroadcast,cmUpdate,nil);
end;
if OK=false then
ErrorBox('Error loading desktop',nil);
end;
Dispose(S, Done);
PopStatus;
ReadOpenWindows:=OK;
end;
function WriteOpenWindows(F: PResourceFile): boolean;
var S: PMemoryStream;
W: word;
OK: boolean;
begin
PushStatus('Storing desktop contents...');
New(S, Init(30*1024,4096));
OK:=Assigned(S);
if OK then
begin
W:=DesktopVersion;
S^.Write(W,SizeOf(W));
S^.Put(Desktop);
with Desktop^ do
begin
PutSubViewPtr(S^,CompilerMessageWindow);
PutSubViewPtr(S^,CompilerStatusDialog);
PutSubViewPtr(S^,ClipboardWindow);
PutSubViewPtr(S^,CalcWindow);
PutSubViewPtr(S^,ProgramInfoWindow);
PutSubViewPtr(S^,GDBWindow);
PutSubViewPtr(S^,BreakpointsWindow);
PutSubViewPtr(S^,WatchesWindow);
PutSubViewPtr(S^,UserScreenWindow);
PutSubViewPtr(S^,ASCIIChart);
PutSubViewPtr(S^,MessagesWindow);
end;
OK:=(S^.Status=stOK);
if OK then
begin
S^.Seek(0);
OK:=F^.CreateResource(resDesktop,rcBinary,0);
OK:=OK and F^.AddResourceEntryFromStream(resDesktop,langDefault,0,S^,S^.GetSize);
end;
Dispose(S, Done);
end;
if OK=false then
ErrorBox('Error storing desktop',nil);
PopStatus;
WriteOpenWindows:=OK;
end;
function WriteFlags(F: PResourceFile): boolean;
var
OK: boolean;
begin
F^.CreateResource(resDesktopFlags,rcBinary,0);
OK:=F^.AddResourceEntry(resDesktopFlags,langDefault,0,DesktopFileFlags,
SizeOf(DesktopFileFlags));
if OK=false then
ErrorBox('Error writing flags',nil);
WriteFlags:=OK;
end;
function ReadCodeComplete(F: PResourceFile): boolean;
var S: PMemoryStream;
OK: boolean;
R: PResource;
begin
PushStatus('Reading CodeComplete wordlist...');
New(S, Init(1024,1024));
OK:=F^.ReadResourceEntryToStream(resCodeComplete,langDefault,S^);
S^.Seek(0);
if OK then
OK:=LoadCodeComplete(S^);
Dispose(S, Done);
if OK=false then
ErrorBox('Error loading CodeComplete wordlist',nil);
PopStatus;
ReadCodeComplete:=OK;
end;
function WriteCodeComplete(F: PResourceFile): boolean;
var OK: boolean;
S: PMemoryStream;
begin
PushStatus('Writing CodeComplete wordlist...');
New(S, Init(1024,1024));
OK:=StoreCodeComplete(S^);
if OK then
begin
S^.Seek(0);
F^.CreateResource(resCodeComplete,rcBinary,0);
OK:=F^.AddResourceEntryFromStream(resCodeComplete,langDefault,0,S^,S^.GetSize);
end;
Dispose(S, Done);
if OK=false then
ErrorBox('Error writing CodeComplete wordlist',nil);
PopStatus;
WriteCodeComplete:=OK;
end;
function ReadCodeTemplates(F: PResourceFile): boolean;
var S: PMemoryStream;
OK: boolean;
R: PResource;
begin
PushStatus('Reading CodeTemplates...');
New(S, Init(1024,4096));
OK:=F^.ReadResourceEntryToStream(resCodeTemplates,langDefault,S^);
S^.Seek(0);
if OK then
OK:=LoadCodeTemplates(S^);
Dispose(S, Done);
if OK=false then
ErrorBox('Error loading CodeTemplates wordlist',nil);
PopStatus;
ReadCodeTemplates:=OK;
end;
function WriteCodeTemplates(F: PResourceFile): boolean;
var OK: boolean;
S: PMemoryStream;
begin
PushStatus('Writing CodeTemplates...');
New(S, Init(1024,4096));
OK:=StoreCodeTemplates(S^);
if OK then
begin
S^.Seek(0);
F^.CreateResource(resCodeTemplates,rcBinary,0);
OK:=F^.AddResourceEntryFromStream(resCodeTemplates,langDefault,0,S^,S^.GetSize);
end;
Dispose(S, Done);
if OK=false then
ErrorBox('Error writing CodeTemplates',nil);
PopStatus;
WriteCodeTemplates:=OK;
end;
function ReadFlags(F: PResourceFile): boolean;
var
size : sw_word;
OK: boolean;
begin
OK:=F^.ReadResourceEntry(resDesktopFlags,langDefault,DesktopFileFlags,
size);
if OK=false then
ErrorBox('Error loading flags',nil);
ReadFlags:=OK;
end;
function WriteVideoMode(F: PResourceFile): boolean;
var
OK: boolean;
begin
F^.CreateResource(resVideo,rcBinary,0);
OK:=F^.AddResourceEntry(resVideo,langDefault,0,ScreenMode,
SizeOf(TVideoMode));
if OK=false then
ErrorBox('Error storing video mode',nil);
WriteVideoMode:=OK;
end;
function ReadVideoMode(F: PResourceFile;var NewScreenMode : TVideoMode): boolean;
var
size : sw_word;
OK,test : boolean;
begin
size:=SizeOf(TVideoMode);
test:=F^.ReadResourceEntry(resVideo,langDefault,NewScreenMode,
size);
if not test then
NewScreenMode:=ScreenMode;
OK:=test and (size = SizeOf(TVideoMode));
if OK=false then
ErrorBox('Error loading video mode',nil);
ReadVideoMode:=OK;
end;
function ReadSymbols(F: PResourceFile): boolean;
var S: PMemoryStream;
OK: boolean;
R: PResource;
begin
{ if no symbols stored ... no problems }
R:=F^.FindResource(resSymbols);
if not Assigned(R) then
exit;
PushStatus('Reading symbol information...');
New(S, Init(32*1024,4096));
OK:=F^.ReadResourceEntryToStream(resSymbols,langDefault,S^);
S^.Seek(0);
if OK then
OK:=LoadBrowserCol(S);
Dispose(S, Done);
if OK=false then
ErrorBox('Error loading symbol information',nil);
PopStatus;
ReadSymbols:=OK;
end;
function WriteSymbols(F: PResourceFile): boolean;
var S: PMemoryStream;
OK: boolean;
begin
OK:=Assigned(Modules);
if OK then
begin
PushStatus('Storing symbol information...');
New(S, Init(200*1024,4096));
OK:=Assigned(S);
if OK then
OK:=StoreBrowserCol(S);
if OK then
begin
S^.Seek(0);
F^.CreateResource(resSymbols,rcBinary,0);
OK:=F^.AddResourceEntryFromStream(resSymbols,langDefault,0,S^,S^.GetSize);
end;
Dispose(S, Done);
if OK=false then
ErrorBox('Error storing symbol information',nil);
PopStatus;
end;
WriteSymbols:=OK;
end;
function LoadDesktop: boolean;
var OK,VOK: boolean;
F: PResourceFile;
VM : TVideoMode;
begin
PushStatus('Reading desktop file...');
New(F, LoadFile(GetShortName(DesktopPath)));
OK:=false;
if Assigned(F) then
begin
OK:=ReadFlags(F);
VOK:=ReadVideoMode(F,VM);
if VOK and ((VM.Col<>ScreenMode.Col) or
(VM.Row<>ScreenMode.Row) or (VM.Color<>ScreenMode.Color)) then
Application^.SetScreenVideoMode(VM);
if ((DesktopFileFlags and dfHistoryLists)<>0) then
OK:=OK and ReadHistory(F);
if ((DesktopFileFlags and dfWatches)<>0) then
OK:=OK and ReadWatches(F);
if ((DesktopFileFlags and dfOpenWindows)<>0) then
OK:=OK and ReadOpenWindows(F);
if ((DesktopFileFlags and dfBreakpoints)<>0) then
OK:=OK and ReadBreakpoints(F);
{ no errors if no browser info available PM }
if ((DesktopFileFlags and dfSymbolInformation)<>0) then
OK:=OK and ReadSymbols(F);
if ((DesktopFileFlags and dfCodeCompleteWords)<>0) then
OK:=OK and ReadCodeComplete(F);
if ((DesktopFileFlags and dfCodeTemplates)<>0) then
OK:=OK and ReadCodeTemplates(F);
Dispose(F, Done);
end;
PopStatus;
LoadDesktop:=OK;
end;
function SaveDesktop: boolean;
var OK: boolean;
F: PResourceFile;
TempPath: string;
begin
TempPath:=DirOf(DesktopPath)+DesktopTempName;
PushStatus('Writing desktop file...');
New(F, CreateFile(GetShortName(TempPath)));
if Assigned(Clipboard) then
if (DesktopFileFlags and dfClipboardContent)<>0 then
Clipboard^.Flags:=Clipboard^.Flags or efStoreContent
else
Clipboard^.Flags:=Clipboard^.Flags and not efStoreContent;
OK:=false;
if Assigned(F) then
begin
OK:=WriteFlags(F);
OK:=OK and WriteVideoMode(F);
if ((DesktopFileFlags and dfHistoryLists)<>0) then
OK:=OK and WriteHistory(F);
if ((DesktopFileFlags and dfWatches)<>0) then
OK:=OK and WriteWatches(F);
if ((DesktopFileFlags and dfOpenWindows)<>0) then
OK:=OK and WriteOpenWindows(F);
if ((DesktopFileFlags and dfBreakpoints)<>0) then
OK:=OK and WriteBreakpoints(F);
{ no errors if no browser info available PM }
if ((DesktopFileFlags and dfSymbolInformation)<>0) then
OK:=OK and (WriteSymbols(F) or not Assigned(Modules));
if ((DesktopFileFlags and dfCodeCompleteWords)<>0) then
OK:=OK and WriteCodeComplete(F);
if ((DesktopFileFlags and dfCodeTemplates)<>0) then
OK:=OK and WriteCodeTemplates(F);
Dispose(F, Done);
end;
if OK then
begin
if ExistsFile(DesktopPath) then
OK:=EraseFile(DesktopPath);
OK:=OK and RenameFile(TempPath,DesktopPath);
if OK=false then
ErrorBox('Failed to replace desktop file.',nil);
end;
PopStatus;
SaveDesktop:=OK;
end;
function WriteSymbolsFile(const filename : string): boolean;
var OK: boolean;
F: PResourceFile;
begin
WriteSymbolsFile:=false;
If not assigned(Modules) then
exit;
New(F, CreateFile(GetShortName(FileName)));
OK:=Assigned(F);
if OK and ((DesktopFileFlags and dfSymbolInformation)<>0) then
OK:=OK and WriteSymbols(F);
if assigned(F) then
Dispose(F,Done);
WriteSymbolsFile:=OK;
end;
function ReadSymbolsFile(const FileName : string): boolean;
var OK: boolean;
F: PResourceFile;
begin
ReadSymbolsFile:=false;
{ Don't read again !! }
If assigned(Modules) then
exit;
New(F, LoadFile(GetShortName(FileName)));
OK:=Assigned(F);
if OK and ((DesktopFileFlags and dfSymbolInformation)<>0) then
OK:=OK and ReadSymbols(F);
if assigned(F) then
Dispose(F,Done);
ReadSymbolsFile:=OK;
end;
END.
{
$Log$
Revision 1.22 2000-02-07 12:03:48 pierre
Last commit is from Gabor's changes!
Revision 1.21 2000/02/07 11:55:27 pierre
+ Code Complete and Template saving from Gabor
Revision 1.20 2000/02/04 00:12:57 pierre
* Breakpoint are marked in source at desktop loading
Revision 1.19 2000/01/25 00:26:36 pierre
+ Browser info saving
Revision 1.18 2000/01/03 11:38:33 michael
Changes from Gabor
Revision 1.17 1999/12/20 00:30:56 pierre
* problem with VideoMode storing solved
Revision 1.16 1999/12/10 13:02:05 pierre
+ VideoMode save/restore
Revision 1.15 1999/11/26 17:09:51 pierre
* Force Desktop into Screen
Revision 1.14 1999/11/25 00:25:43 pierre
* add Status when loading/saving files
Revision 1.13 1999/09/20 15:37:59 pierre
* ReadOpenWindows and ReadSymobls was missing, still does not work correctly :(
Revision 1.12 1999/09/17 16:41:10 pierre
* other stream error for Watches/Breakpoints corrected
Revision 1.11 1999/09/17 16:28:58 pierre
* ResWatches in WriteBreakpoints typo !
Revision 1.10 1999/09/16 14:34:58 pierre
+ TBreakpoint and TWatch registering
+ WatchesCollection and BreakpointsCollection stored in desk file
* Syntax highlighting was broken
Revision 1.9 1999/09/07 09:23:00 pierre
* no errors if no browser info available
Revision 1.8 1999/08/16 18:25:16 peter
* Adjusting the selection when the editor didn't contain any line.
* Reserved word recognition redesigned, but this didn't affect the overall
syntax highlight speed remarkably (at least not on my Amd-K6/350).
The syntax scanner loop is a bit slow but the main problem is the
recognition of special symbols. Switching off symbol processing boosts
the performance up to ca. 200%...
* The editor didn't allow copying (for ex to clipboard) of a single character
* 'File|Save as' caused permanently run-time error 3. Not any more now...
* Compiler Messages window (actually the whole desktop) did not act on any
keypress when compilation failed and thus the window remained visible
+ Message windows are now closed upon pressing Esc
+ At 'Run' the IDE checks whether any sources are modified, and recompiles
only when neccessary
+ BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
+ LineSelect (Ctrl+K+L) implemented
* The IDE had problems closing help windows before saving the desktop
Revision 1.7 1999/08/03 20:22:30 peter
+ TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
+ Desktop saving should work now
- History saved
- Clipboard content saved
- Desktop saved
- Symbol info saved
* syntax-highlight bug fixed, which compared special keywords case sensitive
(for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
* with 'whole words only' set, the editor didn't found occourences of the
searched text, if the text appeared previously in the same line, but didn't
satisfied the 'whole-word' condition
* ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
(ie. the beginning of the selection)
* when started typing in a new line, but not at the start (X=0) of it,
the editor inserted the text one character more to left as it should...
* TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
* Shift shouldn't cause so much trouble in TCodeEditor now...
* Syntax highlight had problems recognizing a special symbol if it was
prefixed by another symbol character in the source text
* Auto-save also occours at Dos shell, Tool execution, etc. now...
Revision 1.5 1999/06/30 23:58:13 pierre
+ BreakpointsList Window implemented
with Edit/New/Delete functions
+ Individual breakpoint dialog with support for all types
ignorecount and conditions
(commands are not yet implemented, don't know if this wolud be useful)
awatch and rwatch have problems because GDB does not annotate them
I fixed v4.16 for this
Revision 1.4 1999/04/15 08:58:05 peter
* syntax highlight fixes
* browser updates
Revision 1.3 1999/04/07 21:55:45 peter
+ object support for browser
* html help fixes
* more desktop saving things
* NODEBUG directive to exclude debugger
Revision 1.2 1999/03/23 16:16:39 peter
* linux fixes
Revision 1.1 1999/03/23 15:11:28 peter
* desktop saving things
* vesa mode
* preferences dialog
}