123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065 |
- {
- 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;
- {$H-}
- 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,
- Video,
- Views,App,HistList,BrowCol,
- WUtils,WResourc,WViews,WEditor,
- fpdebug, wcedit,
- {$ifdef Unix}
- FPKeys,
- {$endif Unix}
- FPConst,FPVars,FPTools,FPUtils,FPViews,FPHelp,
- FPCompil,FPCodCmp,FPCodTmp;
- type
- TWindowInfo =
- {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
- packed
- {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
- record
- HelpCtx : word;
- Bounds : TRect;
- Visible : boolean;
- WinNb : byte;
- ExtraDataSize : word;
- TitleLen : word;
- Title : packed record end;
- end;
- {$ifdef useresstrings}
- resourcestring
- {$else}
- const
- {$endif}
- { Desktop file messages }
- msg_readingdesktopfile = 'Reading desktop file...';
- msg_writingdesktopfile = 'Writing desktop file...';
- msg_readingdesktopcontents = 'Reading desktop contents...';
- msg_storingdesktopcontents = 'Storing desktop contents...';
- msg_readinghistory = 'Reading history...';
- msg_storinghistory = 'Storing history...';
- msg_readingwatches = 'Reading watches...';
- msg_storingwatches = 'Storing watches...';
- msg_readingbreakpoints = 'Reading breakpoints...';
- msg_storingbreakpoints = 'Storing breakpoints...';
- msg_readingcodecompletewordlist = 'Reading CodeComplete wordlist...';
- msg_storingcodecompletewordlist = 'Writing CodeComplete wordlist...';
- msg_readingcodetemplates = 'Reading CodeTemplates...';
- msg_storingcodetemplates = 'Writing CodeTemplates...';
- msg_readingsymbolinformation = 'Reading symbol information...';
- msg_storingsymbolinformation = 'Storing symbol information...';
- msg_failedtoreplacedesktopfile = 'Failed to replace desktop file.';
- msg_errorloadinghistory = 'Error loading history';
- msg_errorstoringhistory = 'Error storing history';
- msg_errorloadingkeys = 'Error loading custom keys';
- msg_errorstoringkeys = 'Error storing custom keys';
- msg_errorloadingwatches = 'Error loading watches';
- msg_errorstoringwatches = 'Error storing watches';
- msg_errorloadingbreakpoints = 'Error loading breakpoints';
- msg_errorstoringbreakpoints = 'Error storing breakpoints';
- msg_errorloadingdesktop = 'Error loading desktop';
- msg_errorstoringdesktop = 'Error storing desktop';
- msg_errorreadingflags = 'Error loading flags';
- msg_errorwritingflags = 'Error writing flags';
- msg_errorreadingvideomode = 'Error reading video mode';
- msg_errorstoringvideomode = 'Error storing video mode';
- msg_errorloadingcodetemplates = 'Error loading CodeTemplates';
- msg_errorstoringcodetemplates = 'Error writing CodeTemplates';
- msg_errorloadingsymbolinformation = 'Error loading symbol information';
- msg_errorstoringsymbolinformation = 'Error storing symbol information';
- msg_errorloadingcodecompletewordlist = 'Error loading CodeComplete wordlist';
- msg_errorstoringcodecompletewordlist = 'Error writing CodeComplete wordlist';
- msg_invaliddesktopversionlayoutlost = 'Invalid desktop version. Desktop layout lost.';
- msg_saveansifile = 'Save previous screen as Ansi File';
- msg_click_upper_left = 'Click to select upper left corner; Escape to cancel; Enter to select (0,0)';
- msg_click_lower_right = 'Click to select lower right corner; Escape to cancel; Enter to select (maxX,maxY)';
- msg_cantopenfile = 'Can''t open %s';
- msg_cantcreatefile = 'Can''t create %s';
- msg_cantfindfile = 'Can''t find %s';
- msg_errorreadingfile = 'Error reading file %s';
- msg_loadingfile = 'Loading %s';
- msg_storingfile = 'Storing %s';
- msg_closingfile = 'Closing %s';
- msg_openingsourcefile = 'Opening source file... (%s)';
- msg_readingfileineditor = 'Reading %s into editor...';
- 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));
- S^.Put(BreakpointsCollection);
- 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 DeskUseSyntaxHighlight(Editor: PFileEditor): boolean;
- var b : boolean;
- begin
- b:= (*(Editor^.IsFlagSet(efSyntaxHighlight)) and *) ((Editor^.FileName='') or
- MatchesMaskList(NameAndExtOf(Editor^.FileName),HighlightExts));
- DeskUseSyntaxHighlight:=b;
- 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
- if Size>0 Then
- Begin
- Move(XData[XDataOfs],B,Size);
- Inc(XDataOfs,Size);
- End;
- end;
- procedure ProcessWindowInfo;
- var W: PWindow;
- SW: PSourceWindow absolute W;
- St: string;
- Ch: AnsiChar;
- TP,TP2: TPoint;
- L: longint;
- R: TRect;
- ZZ: byte;
- Z: TRect;
- Len : Byte;
- begin
- XDataOfs:=0;
- Desktop^.Lock;
- W:=SearchWindow(Title);
- case WI.HelpCtx of
- hcSourceWindow :
- begin
- GetData(len,1);
- SetLength(St,Len);
- GetData(St[1],Len);
- 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));
- If DeskUseSyntaxHighlight(SW^.Editor) Then
- L:=L or efSyntaxHighlight
- else
- L:=L and not efSyntaxHighlight;
- 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;
- {$ifndef NODEBUG}
- hcGDBWindow:
- begin
- InitGDBWindow;
- W:=GDBWindow;
- end;
- hcDisassemblyWindow:
- begin
- InitDisassemblyWindow;
- W:=DisassemblyWindow;
- 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;
- hcVectorRegisters:
- begin
- if VectorWindow=nil then
- begin
- New(VectorWindow,Init);
- Desktop^.Insert(VectorWindow);
- end;
- W:=VectorWindow;
- 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;
- {$endif NODEBUG}
- hcASCIITableWindow:
- begin
- if ASCIIChart=nil then
- begin
- New(ASCIIChart, Init);
- Desktop^.Insert(ASCIIChart);
- end;
- W:=ASCIIChart;
- if DV>=$A then
- begin
- GetData(ch,sizeof(AnsiChar));
- 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;
- ZZ:=0;
- Desktop^.GetExtent(Z);
- if R.A.Y>Z.B.Y-7 then
- begin
- R.A.Y:=Z.B.Y-7;
- ZZ:=1;
- end;
- if R.A.X>Z.B.X-4 then
- begin
- R.A.X:=Z.B.X-4;
- ZZ:=1;
- end;
- if R.A.Y<0 then
- begin
- R.A.Y:=0;
- ZZ:=1;
- end;
- if R.A.X<0 then
- begin
- R.A.X:=0;
- ZZ:=1;
- end;
- if ZZ<>0 then W^.MoveTo(R.A.X,R.A.Y);
- 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
- SetLength(Title,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^,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);
- var W: PWindow;
- SW: PSourceWindow absolute W;
- WI: TWindowInfo;
- Title: string;
- XDataOfs: word;
- XData: array[0..1024] of byte;
- St: string;
- Ch: AnsiChar;
- 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=hcVectorRegisters) 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(AnsiChar));
- 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^,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
- OK: boolean;
- begin
- OK:=F^.ReadResourceEntry(resDesktopFlags,langDefault,DesktopFileFlags,
- sizeof(DesktopFileFlags));
- 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
- OK,test : boolean;
- begin
- test:=F^.ReadResourceEntry(resVideo,langDefault,NewScreenMode,
- sizeof(NewScreenMode));
- if not test then
- NewScreenMode:=ScreenMode;
- OK:=test;
- if OK=false then
- ErrorBox(msg_errorreadingvideomode,nil);
- ReadVideoMode:=OK;
- end;
- function ReadSymbols(F: PResourceFile): boolean;
- var S: PMemoryStream;
- OK: boolean;
- R: PResource;
- begin
- ReadSymbols:=false; { 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:=ReadHistory(F) and OK;
- if ((DesktopFileFlags and dfWatches)<>0) then
- OK:=ReadWatches(F) and OK;
- if ((DesktopFileFlags and dfBreakpoints)<>0) then
- OK:=ReadBreakpoints(F) and OK;
- if ((DesktopFileFlags and dfOpenWindows)<>0) then
- OK:=ReadOpenWindows(F) and OK;
- { no errors if no browser info available PM }
- if ((DesktopFileFlags and dfSymbolInformation)<>0) then
- OK:=ReadSymbols(F) and OK;
- if ((DesktopFileFlags and dfCodeCompleteWords)<>0) then
- OK:=ReadCodeComplete(F) and OK;
- if ((DesktopFileFlags and dfCodeTemplates)<>0) then
- OK:=ReadCodeTemplates(F) and OK;
- {$ifdef Unix}
- OK:=ReadKeys(F) and OK;
- {$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.
|