123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978 |
- {
- $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
- MinDesktopVersion = $000A;
- DesktopVersion = $000A; { <- 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';
- ResKeys = 'KEYS';
- 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,
- {$ifndef FVISION}
- Video,
- {$else FVISION}
- {$ifndef GRAPH_API}
- Video,
- {$endif GRAPH_API}
- {$endif FVISION}
- Views,App,HistList,BrowCol,
- WUtils,WResourc,WViews,WEditor,
- {$ifndef NODEBUG}
- fpdebug,
- {$endif ndef NODEBUG}
- {$ifdef Unix}
- FPKeys,
- {$endif Unix}
- FPConst,FPVars,FPString,FPTools,FPUtils,FPViews,FPHelp,
- FPCompil,FPCodCmp,FPCodTmp;
- type
- TWindowInfo = packed record
- HelpCtx : word;
- Bounds : TRect;
- Visible : boolean;
- WinNb : byte;
- ExtraDataSize : word;
- TitleLen : word;
- Title : packed record end;
- end;
- procedure InitDesktopFile;
- begin
- if DesktopLocation=dlCurrentDir then
- DesktopPath:=FExpand(DesktopName)
- else
- DesktopPath:=FExpand(DirOf(IniFileName)+DesktopName);
- end;
- procedure DoneDesktopFile;
- begin
- end;
- function ReadHistory(F: PResourceFile): boolean;
- var S: PMemoryStream;
- OK: boolean;
- begin
- PushStatus(msg_readinghistory);
- 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(msg_errorloadinghistory,nil);
- PopStatus;
- ReadHistory:=OK;
- end;
- function WriteHistory(F: PResourceFile): boolean;
- var S: PMemoryStream;
- OK: boolean;
- begin
- PushStatus(msg_storinghistory);
- 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(msg_errorstoringhistory,nil);
- PopStatus;
- WriteHistory:=OK;
- end;
- {$ifdef Unix}
- function ReadKeys(F: PResourceFile): boolean;
- var S: PMemoryStream;
- OK: boolean;
- begin
- New(S, Init(32*1024,4096));
- OK:=F^.ReadResourceEntryToStream(resKeys,langDefault,S^);
- S^.Seek(0);
- if OK then
- LoadKeys(S^);
- Dispose(S, Done);
- if OK=false then
- ErrorBox(msg_errorloadingkeys,nil);
- ReadKeys:=OK;
- end;
- function WriteKeys(F: PResourceFile): boolean;
- var S: PMemoryStream;
- OK: boolean;
- begin
- New(S, Init(10*1024,4096));
- StoreKeys(S^);
- S^.Seek(0);
- F^.CreateResource(resKeys,rcBinary,0);
- OK:=F^.AddResourceEntryFromStream(resKeys,langDefault,0,S^,S^.GetSize);
- Dispose(S, Done);
- if OK=false then
- ErrorBox(msg_errorstoringkeys,nil);
- WriteKeys:=OK;
- end;
- {$endif Unix}
- (*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(msg_readingwatches);
- 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(msg_errorloadingwatches,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(msg_storingwatches);
- 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(msg_errorstoringwatches,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(msg_readingbreakpoints);
- 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(msg_errorloadingbreakpoints,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(msg_storingbreakpoints);
- 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(msg_errorstoringbreakpoints,nil);
- WriteBreakPoints:=OK;
- PopStatus;
- end;
- {$endif NODEBUG}
- end;
- function ReadOpenWindows(F: PResourceFile): boolean;
- var S: PMemoryStream;
- OK: boolean;
- DV: word;
- WI: TWindowInfo;
- Title: string;
- XDataOfs: word;
- XData: array[0..1024] of byte;
- procedure GetData(var B; Size: word);
- begin
- Move(XData[XDataOfs],B,Size);
- Inc(XDataOfs,Size);
- end;
- procedure ProcessWindowInfo;
- var W: PWindow;
- SW: PSourceWindow absolute W;
- St: string;
- Ch: char;
- TP,TP2: TPoint;
- L: longint;
- R: TRect;
- begin
- XDataOfs:=0;
- Desktop^.Lock;
- W:=SearchWindow(Title);
- case WI.HelpCtx of
- hcSourceWindow :
- begin
- GetData(St[0],1);
- GetData(St[1],ord(St[0]));
- W:=ITryToOpenFile(@WI.Bounds,St,0,0,false,false,true);
- if Assigned(W)=false then
- begin
- ClearFormatParams;
- AddFormatParamStr(St);
- Desktop^.Unlock;
- ErrorBox(msg_cantopenfile,@FormatParams);
- Desktop^.Lock;
- end
- else
- begin
- GetData(L,sizeof(L)); SW^.Editor^.SetFlags(L);
- GetData(TP,sizeof(TP)); GetData(TP2,sizeof(TP2));
- SW^.Editor^.SetSelection(TP,TP2);
- GetData(TP,sizeof(TP)); SW^.Editor^.SetCurPtr(TP.X,TP.Y);
- GetData(TP,sizeof(TP)); SW^.Editor^.ScrollTo(TP.X,TP.Y);
- end;
- end;
- hcClipboardWindow:
- W:=ClipboardWindow;
- hcCalcWindow:
- W:=CalcWindow;
- hcMessagesWindow:
- begin
- if MessagesWindow=nil then
- Desktop^.Insert(New(PMessagesWindow, Init));
- W:=MessagesWindow;
- end;
- hcCompilerMessagesWindow:
- W:=CompilerMessageWindow;
- hcGDBWindow:
- begin
- InitGDBWindow;
- W:=GDBWindow;
- end;
- hcDisassemblyWindow:
- begin
- InitDisassemblyWindow;
- W:=DisassemblyWindow;
- end;
- hcInfoWindow:
- begin
- if ProgramInfoWindow=nil then
- begin
- New(ProgramInfoWindow, Init);
- Desktop^.Insert(ProgramInfoWindow);
- end;
- W:=ProgramInfoWindow;
- end;
- hcWatchesWindow:
- begin
- if WatchesWindow=nil then
- begin
- New(WatchesWindow,Init);
- Desktop^.Insert(WatchesWindow);
- end;
- W:=WatchesWindow;
- end;
- hcStackWindow:
- begin
- if StackWindow=nil then
- begin
- New(StackWindow,Init);
- Desktop^.Insert(StackWindow);
- end;
- W:=StackWindow;
- end;
- hcFPURegisters:
- begin
- if FPUWindow=nil then
- begin
- New(FPUWindow,Init);
- Desktop^.Insert(FPUWindow);
- end;
- W:=FPUWindow;
- end;
- hcRegistersWindow:
- begin
- if RegistersWindow=nil then
- begin
- New(RegistersWindow,Init);
- Desktop^.Insert(RegistersWindow);
- end;
- W:=RegistersWindow;
- end;
- hcBreakpointListWindow:
- begin
- if BreakpointsWindow=nil then
- begin
- New(BreakpointsWindow,Init);
- Desktop^.Insert(BreakpointsWindow);
- end;
- W:=BreakpointsWindow;
- end;
- hcASCIITableWindow:
- begin
- if ASCIIChart=nil then
- begin
- New(ASCIIChart, Init);
- Desktop^.Insert(ASCIIChart);
- end;
- W:=ASCIIChart;
- if DV>=$A then
- begin
- GetData(ch,sizeof(char));
- AsciiChart^.Report^.AsciiChar:=ord(ch);
- AsciiChart^.Table^.SetCursor(
- ord(ch) mod AsciiChart^.Table^.Size.X,
- ord(ch) div AsciiChart^.Table^.Size.X);
- end;
- end;
- end;
- if W=nil then
- begin
- Desktop^.Unlock;
- Exit;
- end;
- W^.GetBounds(R);
- if (R.A.X<>WI.Bounds.A.X) or (R.A.Y<>WI.Bounds.A.Y) then
- R.Move(WI.Bounds.A.X-R.A.X,WI.Bounds.A.Y-R.A.Y);
- if (W^.Flags and wfGrow)<>0 then
- begin
- R.B.X:=R.A.X+(WI.Bounds.B.X-WI.Bounds.A.X);
- R.B.Y:=R.A.Y+(WI.Bounds.B.Y-WI.Bounds.A.Y);
- end;
- W^.Locate(R);
- if W^.GetState(sfVisible)<>WI.Visible then
- if WI.Visible then
- begin
- W^.Show;
- W^.MakeFirst;
- end
- else
- W^.Hide;
- W^.Number:=WI.WinNb;
- Desktop^.Unlock;
- end;
- begin
- PushStatus(msg_readingdesktopcontents);
- New(S, Init(32*1024,4096));
- OK:=F^.ReadResourceEntryToStream(resDesktop,langDefault,S^);
- S^.Seek(0);
- if OK then
- begin
- S^.Read(DV,SizeOf(DV));
- OK:=(DV=DesktopVersion) or (DV>=MinDesktopVersion);
- if OK=false then
- ErrorBox(msg_invaliddesktopversionlayoutlost,nil);
- end;
- if OK then
- begin
- XDataOfs:=0;
- repeat
- S^.Read(WI,sizeof(WI));
- if S^.Status=stOK then
- begin
- Title[0]:=chr(WI.TitleLen);
- S^.Read(Title[1],WI.TitleLen);
- if WI.ExtraDataSize>0 then
- S^.Read(XData,WI.ExtraDataSize);
- ProcessWindowInfo;
- end;
- until (S^.Status<>stOK) or (S^.GetPos=S^.GetSize);
- (* 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(msg_errorloadingdesktop,nil);
- end;
- Dispose(S, Done);
- PopStatus;
- ReadOpenWindows:=OK;
- end;
- function WriteOpenWindows(F: PResourceFile): boolean;
- var S: PMemoryStream;
- procedure CollectInfo(P: PView); {$ifndef FPC}far;{$endif}
- var W: PWindow;
- SW: PSourceWindow absolute W;
- WI: TWindowInfo;
- Title: string;
- XDataOfs: word;
- XData: array[0..1024] of byte;
- St: string;
- Ch: char;
- TP: TPoint;
- L: longint;
- procedure AddData(const B; Size: word);
- begin
- Move(B,XData[XDataOfs],Size);
- Inc(XDataOfs,Size);
- end;
- begin
- XDataOfs:=0;
- W:=nil;
- if (P^.HelpCtx=hcSourceWindow) or
- (P^.HelpCtx=hcHelpWindow) or
- (P^.HelpCtx=hcClipboardWindow) or
- (P^.HelpCtx=hcCalcWindow) or
- (P^.HelpCtx=hcInfoWindow) or
- (P^.HelpCtx=hcBrowserWindow) or
- (P^.HelpCtx=hcMessagesWindow) or
- (P^.HelpCtx=hcCompilerMessagesWindow) or
- (P^.HelpCtx=hcGDBWindow) or
- (P^.HelpCtx=hcDisassemblyWindow) or
- (P^.HelpCtx=hcStackWindow) or
- (P^.HelpCtx=hcRegistersWindow) or
- (P^.HelpCtx=hcFPURegisters) or
- (P^.HelpCtx=hcWatchesWindow) or
- (P^.HelpCtx=hcBreakpointListWindow) or
- (P^.HelpCtx=hcASCIITableWindow)
- then
- W:=PWindow(P);
- if Assigned(W) and (P^.HelpCtx=hcSourceWindow) then
- if SW^.Editor^.FileName='' then
- W:=nil;
- if W=nil then Exit;
- FillChar(WI,sizeof(WI),0);
- Title:=W^.GetTitle(255);
- WI.HelpCtx:=W^.HelpCtx;
- W^.GetBounds(WI.Bounds);
- WI.Visible:=W^.GetState(sfVisible);
- WI.WinNb:=W^.Number;
- case WI.HelpCtx of
- hcSourceWindow :
- begin
- St:=SW^.Editor^.FileName; AddData(St,length(St)+1);
- L:=SW^.Editor^.GetFlags; AddData(L,sizeof(L));
- TP:=SW^.Editor^.SelStart; AddData(TP,sizeof(TP));
- TP:=SW^.Editor^.SelEnd; AddData(TP,sizeof(TP));
- TP:=SW^.Editor^.CurPos; AddData(TP,sizeof(TP));
- TP:=SW^.Editor^.Delta; AddData(TP,sizeof(TP));
- end;
- hcAsciiTableWindow :
- begin
- ch:=chr(PFPAsciiChart(P)^.Report^.AsciiChar);
- AddData(ch,sizeof(char));
- end;
- end;
- WI.TitleLen:=length(Title);
- WI.ExtraDataSize:=XDataOfs;
- S^.Write(WI,sizeof(WI));
- S^.Write(Title[1],WI.TitleLen);
- if WI.ExtraDataSize>0 then
- S^.Write(XData,WI.ExtraDataSize);
- end;
- var W: word;
- OK: boolean;
- PV: PView;
- begin
- PushStatus(msg_storingdesktopcontents);
- 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;}
- { PV:=Application^.Last;
- while PV<>nil do
- begin
- CollectInfo(PV);
- PV:=PV^.PrevView;
- end;}
- PV:=Desktop^.Last;
- while PV<>nil do
- begin
- CollectInfo(PV);
- PV:=PV^.PrevView;
- 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(msg_errorstoringdesktop,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(msg_errorwritingflags,nil);
- WriteFlags:=OK;
- end;
- function ReadCodeComplete(F: PResourceFile): boolean;
- var S: PMemoryStream;
- OK: boolean;
- begin
- PushStatus(msg_readingcodecompletewordlist);
- 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(msg_errorloadingcodecompletewordlist,nil);
- PopStatus;
- ReadCodeComplete:=OK;
- end;
- function WriteCodeComplete(F: PResourceFile): boolean;
- var OK: boolean;
- S: PMemoryStream;
- begin
- PushStatus(msg_storingcodecompletewordlist);
- 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(msg_errorstoringcodecompletewordlist,nil);
- PopStatus;
- WriteCodeComplete:=OK;
- end;
- function ReadCodeTemplates(F: PResourceFile): boolean;
- var S: PMemoryStream;
- OK: boolean;
- begin
- PushStatus(msg_readingcodetemplates);
- 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(msg_errorloadingcodetemplates,nil);
- PopStatus;
- ReadCodeTemplates:=OK;
- end;
- function WriteCodeTemplates(F: PResourceFile): boolean;
- var OK: boolean;
- S: PMemoryStream;
- begin
- PushStatus(msg_storingcodetemplates);
- 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(msg_errorstoringcodetemplates,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(msg_errorreadingflags,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(msg_errorstoringvideomode,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(msg_errorreadingvideomode,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(msg_readingsymbolinformation);
- 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(msg_errorloadingsymbolinformation,nil);
- PopStatus;
- ReadSymbols:=OK;
- end;
- function WriteSymbols(F: PResourceFile): boolean;
- var S: PMemoryStream;
- OK: boolean;
- begin
- OK:=Assigned(Modules);
- if OK then
- begin
- PushStatus(msg_storingsymbolinformation);
- 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(msg_errorstoringsymbolinformation,nil);
- PopStatus;
- end;
- WriteSymbols:=OK;
- end;
- function LoadDesktop: boolean;
- var OK,VOK: boolean;
- F: PResourceFile;
- VM : TVideoMode;
- begin
- PushStatus(msg_readingdesktopfile);
- New(F, LoadFile(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
- begin
- if Assigned(Application) then
- Application^.SetScreenVideoMode(VM);
- end;
- 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 dfBreakpoints)<>0) then
- OK:=OK and ReadBreakpoints(F);
- if ((DesktopFileFlags and dfOpenWindows)<>0) then
- OK:=OK and ReadOpenWindows(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);
- {$ifdef Unix}
- OK:=OK and ReadKeys(F);
- {$endif Unix}
- Dispose(F, Done);
- end;
- PopStatus;
- LoadDesktop:=OK;
- end;
- function SaveDesktop: boolean;
- var OK: boolean;
- F: PResourceFile;
- TempPath: string;
- begin
- TempPath:=DirOf(DesktopPath)+DesktopTempName;
- PushStatus(msg_writingdesktopfile);
- New(F, CreateFile(TempPath));
- if Assigned(Clipboard) then
- if (DesktopFileFlags and dfClipboardContent)<>0 then
- Clipboard^.SetFlags(Clipboard^.GetFlags or efStoreContent)
- else
- Clipboard^.SetFlags(Clipboard^.GetFlags 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 dfBreakpoints)<>0) then
- OK:=OK and WriteBreakpoints(F);
- if ((DesktopFileFlags and dfOpenWindows)<>0) then
- OK:=OK and WriteOpenWindows(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);
- {$ifdef Unix}
- OK:=OK and WriteKeys(F);
- {$endif Unix}
- 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(msg_failedtoreplacedesktopfile,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(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(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.6 2002-09-07 15:40:42 peter
- * old logs removed and tabs fixed
- Revision 1.5 2002/09/04 14:03:52 pierre
- * MinDesktopVersion increased because of CodeComplete changes
- Revision 1.4 2002/05/31 12:37:09 pierre
- + register asciitable char
- }
|