1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551 |
- {
- $Id$
- This file is part of the Free Pascal Integrated Development Environment
- Copyright (c) 1998 by Berczi Gabor
- Views and view-related functions for the IDE
- 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 FPViews;
- interface
- uses
- Dos,Objects,Drivers,Commands,HelpCtx,Views,Menus,Dialogs,App,Gadgets,
- ASCIITAB,
- {$ifdef EDITORS}
- Editors,
- {$else}
- WEditor,
- {$endif}
- WUtils,WHelp,WHlpView,WViews,
- Comphook,
- FPConst,FPUsrScr;
- type
- {$IFNDEF EDITORS}
- TEditor = TCodeEditor; PEditor = PCodeEditor;
- {$ENDIF}
- PStoreCollection = ^TStoreCollection;
- TStoreCollection = object(TStringCollection)
- function Add(const S: string): PString;
- end;
- PIntegerLine = ^TIntegerLine;
- TIntegerLine = object(TInputLine)
- constructor Init(var Bounds: TRect; AMin, AMax: longint);
- end;
- PFPHeapView = ^TFPHeapView;
- TFPHeapView = object(THeapView)
- constructor Init(var Bounds: TRect);
- constructor InitKb(var Bounds: TRect);
- procedure HandleEvent(var Event: TEvent); virtual;
- end;
- TFPWindow = object(TWindow)
- procedure HandleEvent(var Event: TEvent); virtual;
- end;
- PFPHelpViewer = ^TFPHelpViewer;
- TFPHelpViewer = object(THelpViewer)
- function GetLocalMenu: PMenu; virtual;
- function GetCommandTarget: PView; virtual;
- end;
- PFPHelpWindow = ^TFPHelpWindow;
- TFPHelpWindow = object(THelpWindow)
- constructor Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word; AContext: THelpCtx; ANumber: Integer);
- procedure InitHelpView; virtual;
- procedure Show; virtual;
- procedure Hide; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- function GetPalette: PPalette; virtual;
- end;
- PTextScroller = ^TTextScroller;
- TTextScroller = object(TStaticText)
- TopLine: integer;
- Speed : integer;
- Lines : PUnsortedStringCollection;
- constructor Init(var Bounds: TRect; ASpeed: integer; AText: PUnsortedStringCollection);
- function GetLineCount: integer; virtual;
- function GetLine(I: integer): string; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- procedure Update; virtual;
- procedure Reset; virtual;
- procedure Scroll; virtual;
- procedure Draw; virtual;
- destructor Done; virtual;
- private
- LastTT: longint;
- end;
- PSourceEditor = ^TSourceEditor;
- TSourceEditor = object(TFileEditor)
- constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
- PScrollBar; AIndicator: PIndicator;const AFileName: string);
- {$ifndef EDITORS}
- function IsReservedWord(const S: string): boolean; virtual;
- function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
- function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
- {$endif}
- procedure HandleEvent(var Event: TEvent); virtual;
- function GetLocalMenu: PMenu; virtual;
- function GetCommandTarget: PView; virtual;
- function CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup; virtual;
- end;
- PSourceWindow = ^TSourceWindow;
- TSourceWindow = object(TFPWindow)
- Editor : PSourceEditor;
- Indicator : PIndicator;
- constructor Init(var Bounds: TRect; AFileName: string);
- procedure SetTitle(ATitle: string); virtual;
- procedure UpdateTitle; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- procedure SetState(AState: Word; Enable: Boolean); virtual;
- procedure Update; virtual;
- procedure UpdateCommands; virtual;
- function GetPalette: PPalette; virtual;
- destructor Done; virtual;
- end;
- PGDBSourceEditor = ^TGDBSourceEditor;
- TGDBSourceEditor = object(TSourceEditor)
- function InsertLine : Sw_integer;virtual;
- function Valid(Command: Word): Boolean; virtual;
- procedure AddLine(const S: string); virtual;
- procedure AddErrorLine(const S: string); virtual;
- private
- Silent,
- AutoRepeat,
- IgnoreStringAtEnd : boolean;
- LastCommand : String;
- end;
- PGDBWindow = ^TGDBWindow;
- TGDBWindow = object(TFPWindow)
- Editor : PGDBSourceEditor;
- Indicator : PIndicator;
- constructor Init(var Bounds: TRect);
- procedure WriteText(Buf : pchar;IsError : boolean);
- procedure WriteString(Const S : string);
- procedure WriteErrorString(Const S : string);
- procedure WriteOutputText(Buf : pchar);
- procedure WriteErrorText(Buf : pchar);
- function GetPalette: PPalette;virtual;
- destructor Done; virtual;
- end;
- PClipboardWindow = ^TClipboardWindow;
- TClipboardWindow = object(TSourceWindow)
- constructor Init;
- procedure Show; virtual;
- procedure Hide; virtual;
- procedure Close; virtual;
- destructor Done; virtual;
- end;
- PMessageItem = ^TMessageItem;
- TMessageItem = object(TObject)
- TClass : longint;
- Text : PString;
- Module : PString;
- Row,Col : sw_integer;
- constructor Init(AClass: longint; AText: string; AModule: PString; ARow, ACol: sw_integer);
- function GetText(MaxLen: integer): string; virtual;
- procedure Selected; virtual;
- function GetModuleName: string; virtual;
- destructor Done; virtual;
- end;
- PMessageListBox = ^TMessageListBox;
- TMessageListBox = object(THSListBox)
- Transparent: boolean;
- NoSelection: boolean;
- MaxWidth: integer;
- ModuleNames: PStoreCollection;
- constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
- procedure AddItem(P: PMessageItem); virtual;
- function AddModuleName(Name: string): PString; virtual;
- function GetText(Item: Integer; MaxLen: Integer): String; virtual;
- procedure Clear; virtual;
- procedure TrackSource; virtual;
- procedure GotoSource; virtual;
- procedure Draw; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- function GetLocalMenu: PMenu; virtual;
- destructor Done; virtual;
- end;
- PCompilerMessage = ^TCompilerMessage;
- TCompilerMessage = object(TMessageItem)
- function GetText(MaxLen: Integer): String; virtual;
- end;
- PProgramInfoWindow = ^TProgramInfoWindow;
- TProgramInfoWindow = object(TDlgWindow)
- InfoST: PColorStaticText;
- LogLB : PMessageListBox;
- constructor Init;
- procedure AddMessage(AClass: longint; Msg, Module: string; Line, Column: longint);
- procedure ClearMessages;
- procedure SizeLimits(var Min, Max: TPoint); virtual;
- procedure Close; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- procedure Update; virtual;
- destructor Done; virtual;
- end;
- PTabItem = ^TTabItem;
- TTabItem = record
- Next : PTabItem;
- View : PView;
- Dis : boolean;
- end;
- PTabDef = ^TTabDef;
- TTabDef = record
- Next : PTabDef;
- Name : PString;
- Items : PTabItem;
- DefItem : PView;
- ShortCut : char;
- end;
- PTab = ^TTab;
- TTab = object(TGroup)
- TabDefs : PTabDef;
- ActiveDef : integer;
- DefCount : word;
- constructor Init(var Bounds: TRect; ATabDef: PTabDef);
- function AtTab(Index: integer): PTabDef; virtual;
- procedure SelectTab(Index: integer); virtual;
- function TabCount: integer;
- function Valid(Command: Word): Boolean; virtual;
- procedure ChangeBounds(var Bounds: TRect); virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- function GetPalette: PPalette; virtual;
- procedure Draw; virtual;
- procedure SetState(AState: Word; Enable: Boolean); virtual;
- destructor Done; virtual;
- private
- InDraw: boolean;
- end;
- PScreenView = ^TScreenView;
- TScreenView = object(TScroller)
- Screen: PScreen;
- constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
- AScreen: PScreen);
- procedure Draw; virtual;
- procedure Update; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- end;
- PScreenWindow = ^TScreenWindow;
- TScreenWindow = object(TFPWindow)
- ScreenView : PScreenView;
- constructor Init(AScreen: PScreen; ANumber: integer);
- destructor Done; virtual;
- end;
- PFPAboutDialog = ^TFPAboutDialog;
- TFPAboutDialog = object(TCenterDialog)
- constructor Init;
- procedure ToggleInfo;
- procedure HandleEvent(var Event: TEvent); virtual;
- private
- Scroller: PTextScroller;
- TitleST : PStaticText;
- end;
- PFPASCIIChart = ^TFPASCIIChart;
- TFPASCIIChart = object(TASCIIChart)
- constructor Init;
- procedure HandleEvent(var Event: TEvent); virtual;
- destructor Done; virtual;
- end;
- function SearchFreeWindowNo: integer;
- function IsThereAnyEditor: boolean;
- function IsThereAnyWindow: boolean;
- function FirstEditorWindow: PSourceWindow;
- function EditorWindowFile(const Name : String): PSourceWindow;
- function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
- procedure DisposeTabItem(P: PTabItem);
- function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
- procedure DisposeTabDef(P: PTabDef);
- function GetEditorCurWord(Editor: PEditor): string;
- procedure InitReservedWords;
- procedure DoneReservedWords;
- procedure TranslateMouseClick(View: PView; var Event: TEvent);
- function GetNextEditorBounds(var Bounds: TRect): boolean;
- function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer): PSourceWindow;
- function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts:boolean): PSourceWindow;
- function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
- const
- SourceCmds : TCommandSet =
- ([cmSave,cmSaveAs,cmCompile]);
- EditorCmds : TCommandSet =
- ([cmFind,cmReplace,cmSearchAgain,cmJumpLine,cmHelpTopicSearch]);
- CompileCmds : TCommandSet =
- ([cmMake,cmBuild,cmRun]);
- CalcClipboard : extended = 0;
- OpenFileName : string = '';
- OpenFileLastExt : string[12] = '*.pas';
- NewEditorOpened : boolean = false;
- var MsgParms : array[1..10] of
- record
- case byte of
- 0 : (Ptr : pointer);
- 1 : (Long: longint);
- end;
- implementation
- uses
- Strings,Keyboard,Memory,MsgBox,Validate,
- Tokens,Version,
- FPSwitch,FPSymbol,FPDebug,FPVars,FPUtils,FPCompile,FPHelp;
- const
- NoNameCount : integer = 0;
- ReservedWords : PUnsortedStringCollection = nil;
- {****************************************************************************
- TStoreCollection
- ****************************************************************************}
- function TStoreCollection.Add(const S: string): PString;
- var P: PString;
- Index: Sw_integer;
- begin
- if S='' then P:=nil else
- if Search(@S,Index) then P:=At(Index) else
- begin
- P:=NewStr(S);
- Insert(P);
- end;
- Add:=P;
- end;
- function IsThereAnyEditor: boolean;
- function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
- begin
- EditorWindow:=(P^.HelpCtx=hcSourceWindow);
- end;
- begin
- IsThereAnyEditor:=Desktop^.FirstThat(@EditorWindow)<>nil;
- end;
- function IsThereAnyHelpWindow: boolean;
- begin
- IsThereAnyHelpWindow:=(HelpWindow<>nil) and (HelpWindow^.GetState(sfVisible));
- end;
- function IsThereAnyWindow: boolean;
- var _Is: boolean;
- begin
- _Is:=Message(Desktop,evBroadcast,cmSearchWindow,nil)<>nil;
- _Is:=_Is or ( (ClipboardWindow<>nil) and ClipboardWindow^.GetState(sfVisible));
- IsThereAnyWindow:=_Is;
- end;
- function FirstEditorWindow: PSourceWindow;
- function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
- begin
- EditorWindow:=(P^.HelpCtx=hcSourceWindow);
- end;
- begin
- FirstEditorWindow:=pointer(Desktop^.FirstThat(@EditorWindow));
- end;
- function EditorWindowFile(const Name : String): PSourceWindow;
- function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
- begin
- EditorWindow:=(TypeOf(P^)=TypeOf(TSourceWindow)) and
- {$ifdef linux}
- (PSourceWindow(P)^.Editor^.FileName=Name);
- {$else}
- (UpcaseStr(PSourceWindow(P)^.Editor^.FileName)=UpcaseStr(Name));
- {$endif def linux}
- end;
- begin
- EditorWindowFile:=pointer(Desktop^.FirstThat(@EditorWindow));
- end;
- function GetEditorCurWord(Editor: PEditor): string;
- var S: string;
- PS,PE: byte;
- function Trim(S: string): string;
- const TrimChars : set of char = [#0,#9,' ',#255];
- begin
- while (length(S)>0) and (S[1] in TrimChars) do Delete(S,1,1);
- while (length(S)>0) and (S[length(S)] in TrimChars) do Delete(S,length(S),1);
- Trim:=S;
- end;
- const AlphaNum : set of char = ['A'..'Z','0'..'9','_'];
- begin
- with Editor^ do
- begin
- {$ifdef EDITORS}
- S:='';
- {$else}
- S:=GetLineText(CurPos.Y);
- PS:=CurPos.X; while (PS>0) and (Upcase(S[PS]) in AlphaNum) do Dec(PS);
- PE:=CurPos.X; while (PE<length(S)) and (Upcase(S[PE+1]) in AlphaNum) do Inc(PE);
- S:=Trim(copy(S,PS+1,PE-PS));
- {$endif}
- end;
- GetEditorCurWord:=S;
- end;
- {*****************************************************************************
- Tab
- *****************************************************************************}
- function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
- var P: PTabItem;
- begin
- New(P); FillChar(P^,SizeOf(P^),0);
- P^.Next:=ANext; P^.View:=AView;
- NewTabItem:=P;
- end;
- procedure DisposeTabItem(P: PTabItem);
- begin
- if P<>nil then
- begin
- if P^.View<>nil then Dispose(P^.View, Done);
- Dispose(P);
- end;
- end;
- function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
- var P: PTabDef;
- x: byte;
- begin
- New(P);
- P^.Next:=ANext; P^.Name:=NewStr(AName); P^.Items:=AItems;
- x:=pos('~',AName);
- if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
- else P^.ShortCut:=#0;
- P^.DefItem:=ADefItem;
- NewTabDef:=P;
- end;
- procedure DisposeTabDef(P: PTabDef);
- var PI,X: PTabItem;
- begin
- DisposeStr(P^.Name);
- PI:=P^.Items;
- while PI<>nil do
- begin
- X:=PI^.Next;
- DisposeTabItem(PI);
- PI:=X;
- end;
- Dispose(P);
- end;
- {*****************************************************************************
- Reserved Words
- *****************************************************************************}
- function GetReservedWordCount: integer;
- var
- Count,I: integer;
- begin
- Count:=0;
- for I:=ord(Low(TokenInfo)) to ord(High(TokenInfo)) do
- with TokenInfo[TToken(I)] do
- if (str<>'') and (str[1] in['A'..'Z']) then
- Inc(Count);
- GetReservedWordCount:=Count;
- end;
- function GetReservedWord(Index: integer): string;
- var
- Count,Idx,I: integer;
- S: string;
- begin
- Idx:=-1;
- Count:=-1;
- I:=ord(Low(TokenInfo));
- while (I<=ord(High(TokenInfo))) and (Idx=-1) do
- with TokenInfo[TToken(I)] do
- begin
- if (str<>'') and (str[1] in['A'..'Z']) then
- begin
- Inc(Count);
- if Count=Index then
- Idx:=I;
- end;
- Inc(I);
- end;
- if Idx=-1 then
- S:=''
- else
- S:=TokenInfo[TToken(Idx)].str;
- GetReservedWord:=S;
- end;
- procedure InitReservedWords;
- var S,WordS: string;
- Idx,I: integer;
- begin
- New(ReservedWords, Init(50,10));
- for I:=1 to GetReservedWordCount do
- begin
- WordS:=GetReservedWord(I-1); Idx:=length(WordS);
- while ReservedWords^.Count<Idx do
- ReservedWords^.Insert(NewStr(#0));
- S:=ReservedWords^.At(Idx-1)^;
- ReservedWords^.AtFree(Idx-1);
- ReservedWords^.AtInsert(Idx-1,NewStr(S+WordS+#0));
- end;
- end;
- procedure DoneReservedWords;
- begin
- if assigned(ReservedWords) then
- dispose(ReservedWords,done);
- end;
- function IsFPReservedWord(S: string): boolean;
- var _Is: boolean;
- Idx: integer;
- P: PString;
- begin
- Idx:=length(S); _Is:=false;
- if (Idx>0) and (ReservedWords<>nil) and (ReservedWords^.Count>=Idx) then
- begin
- S:=UpcaseStr(S);
- P:=ReservedWords^.At(Idx-1);
- _Is:=Pos(#0+S+#0,P^)>0;
- end;
- IsFPReservedWord:=_Is;
- end;
- {*****************************************************************************
- SearchWindow
- *****************************************************************************}
- function SearchWindowWithNo(No: integer): PWindow;
- var P: PSourceWindow;
- begin
- P:=Message(Desktop,evBroadcast,cmSearchWindow+No,nil);
- if pointer(P)=pointer(Desktop) then P:=nil;
- SearchWindowWithNo:=P;
- end;
- function SearchFreeWindowNo: integer;
- var No: integer;
- begin
- No:=1;
- while (No<10) and (SearchWindowWithNo(No)<>nil) do
- Inc(No);
- if No=10 then No:=0;
- SearchFreeWindowNo:=No;
- end;
- {*****************************************************************************
- TIntegerLine
- *****************************************************************************}
- constructor TIntegerLine.Init(var Bounds: TRect; AMin, AMax: longint);
- begin
- inherited Init(Bounds, Bounds.B.X-Bounds.A.X-1);
- Validator:=New(PRangeValidator, Init(AMin, AMax));
- end;
- {*****************************************************************************
- SourceEditor
- *****************************************************************************}
- {$ifndef EDITORS}
- function TSourceEditor.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
- var Count: integer;
- begin
- case SpecClass of
- ssCommentPrefix : Count:=3;
- ssCommentSingleLinePrefix : Count:=1;
- ssCommentSuffix : Count:=2;
- ssStringPrefix : Count:=1;
- ssStringSuffix : Count:=1;
- ssAsmPrefix : Count:=1;
- ssAsmSuffix : Count:=1;
- ssDirectivePrefix : Count:=1;
- ssDirectiveSuffix : Count:=1;
- end;
- GetSpecSymbolCount:=Count;
- end;
- function TSourceEditor.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string;
- var S: string[20];
- begin
- case SpecClass of
- ssCommentPrefix :
- case Index of
- 0 : S:='{';
- 1 : S:='(*';
- 2 : S:='//';
- end;
- ssCommentSingleLinePrefix :
- case Index of
- 0 : S:='//';
- end;
- ssCommentSuffix :
- case Index of
- 0 : S:='}';
- 1 : S:='*)';
- end;
- ssStringPrefix :
- S:='''';
- ssStringSuffix :
- S:='''';
- ssAsmPrefix :
- S:='asm';
- ssAsmSuffix :
- S:='end';
- ssDirectivePrefix :
- S:='{$';
- ssDirectiveSuffix :
- S:='}';
- end;
- GetSpecSymbol:=S;
- end;
- constructor TSourceEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
- PScrollBar; AIndicator: PIndicator;const AFileName: string);
- begin
- inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator,AFileName);
- StoreUndo:=true;
- end;
- function TSourceEditor.IsReservedWord(const S: string): boolean;
- begin
- IsReservedWord:=IsFPReservedWord(S);
- end;
- {$endif EDITORS}
- function TSourceEditor.GetLocalMenu: PMenu;
- var M: PMenu;
- begin
- M:=NewMenu(
- NewItem('Cu~t~','Shift+Del',kbShiftDel,cmCut,hcCut,
- NewItem('~C~opy','Ctrl+Ins',kbCtrlIns,cmCopy,hcCopy,
- NewItem('~P~aste','Shift+Ins',kbShiftIns,cmPaste,hcPaste,
- NewItem('C~l~ear','Ctrl+Del',kbCtrlDel,cmClear,hcClear,
- NewLine(
- NewItem('Open ~f~ile at cursor','',kbNoKey,cmOpenAtCursor,hcOpenAtCursor,
- NewItem('~B~rowse symbol at cursor','',kbNoKey,cmBrowseAtCursor,hcBrowseAtCursor,
- NewItem('Topic ~s~earch','Ctrl+F1',kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
- NewLine(
- NewItem('~O~ptions...','',kbNoKey,cmEditorOptions,hcEditorOptions,
- nil)))))))))));
- GetLocalMenu:=M;
- end;
- function TSourceEditor.GetCommandTarget: PView;
- begin
- GetCommandTarget:=@Self;
- end;
- function TSourceEditor.CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup;
- var MV: PAdvancedMenuPopup;
- begin
- New(MV, Init(Bounds,M));
- CreateLocalMenuView:=MV;
- end;
- procedure TSourceEditor.HandleEvent(var Event: TEvent);
- var DontClear: boolean;
- S: string;
- begin
- TranslateMouseClick(@Self,Event);
- case Event.What of
- evCommand :
- begin
- DontClear:=false;
- case Event.Command of
- cmBrowseAtCursor:
- begin
- S:=LowerCaseStr(GetEditorCurWord(@Self));
- OpenOneSymbolBrowser(S);
- end;
- cmOpenAtCursor :
- begin
- S:=LowerCaseStr(GetEditorCurWord(@Self));
- OpenFileName:=S+'.pp'+ListSeparator+
- S+'.pas'+ListSeparator+
- S+'.inc';
- Message(Application,evCommand,cmOpen,nil);
- end;
- cmEditorOptions :
- Message(Application,evCommand,cmEditorOptions,@Self);
- cmHelp :
- Message(@Self,evCommand,cmHelpTopicSearch,@Self);
- cmHelpTopicSearch :
- HelpTopicSearch(@Self);
- else DontClear:=true;
- end;
- if not DontClear then ClearEvent(Event);
- end;
- end;
- inherited HandleEvent(Event);
- end;
- constructor TFPHeapView.Init(var Bounds: TRect);
- begin
- inherited Init(Bounds);
- EventMask:=EventMask or evIdle;
- end;
- constructor TFPHeapView.InitKb(var Bounds: TRect);
- begin
- inherited InitKb(Bounds);
- EventMask:=EventMask or evIdle;
- end;
- procedure TFPHeapView.HandleEvent(var Event: TEvent);
- begin
- case Event.What of
- evIdle :
- Update;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TFPWindow.HandleEvent(var Event: TEvent);
- begin
- case Event.What of
- evBroadcast :
- case Event.Command of
- cmUpdate :
- ReDraw;
- cmSearchWindow+1..cmSearchWindow+99 :
- if (Event.Command-cmSearchWindow=Number) then
- ClearEvent(Event);
- end;
- end;
- inherited HandleEvent(Event);
- end;
- function TFPHelpViewer.GetLocalMenu: PMenu;
- var M: PMenu;
- begin
- M:=NewMenu(
- NewItem('C~o~ntents','',kbNoKey,cmHelpContents,hcHelpContents,
- NewItem('~I~ndex','Shift+F1',kbShiftF1,cmHelpIndex,hcHelpIndex,
- NewItem('~T~opic search','Ctrl+F1',kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
- NewItem('~P~revious topic','Alt+F1',kbAltF1,cmHelpPrevTopic,hcHelpPrevTopic,
- NewLine(
- NewItem('~C~opy','Ctrl+Ins',kbCtrlIns,cmCopy,hcCopy,
- nil)))))));
- GetLocalMenu:=M;
- end;
- function TFPHelpViewer.GetCommandTarget: PView;
- begin
- GetCommandTarget:=Application;
- end;
- constructor TFPHelpWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word;
- AContext: THelpCtx; ANumber: Integer);
- begin
- inherited Init(Bounds,ATitle,ASourceFileID,AContext,ANumber);
- HelpCtx:=hcHelpWindow;
- HideOnClose:=true;
- end;
- procedure TFPHelpWindow.InitHelpView;
- var R: TRect;
- begin
- GetExtent(R); R.Grow(-1,-1);
- HelpView:=New(PFPHelpViewer, Init(R, HSB, VSB));
- HelpView^.GrowMode:=gfGrowHiX+gfGrowHiY;
- end;
- procedure TFPHelpWindow.Show;
- begin
- inherited Show;
- if GetState(sfVisible) and (Number=0) then
- begin
- Number:=SearchFreeWindowNo;
- ReDraw;
- end;
- end;
- procedure TFPHelpWindow.Hide;
- begin
- inherited Hide;
- if GetState(sfVisible)=false then
- Number:=0;
- end;
- procedure TFPHelpWindow.HandleEvent(var Event: TEvent);
- begin
- case Event.What of
- evBroadcast :
- case Event.Command of
- cmUpdate :
- ReDraw;
- cmSearchWindow+1..cmSearchWindow+99 :
- if (Event.Command-cmSearchWindow=Number) then
- ClearEvent(Event);
- end;
- end;
- inherited HandleEvent(Event);
- end;
- function TFPHelpWindow.GetPalette: PPalette;
- const P: string[length(CIDEHelpDialog)] = CIDEHelpDialog;
- begin
- GetPalette:=@P;
- end;
- constructor TSourceWindow.Init(var Bounds: TRect; AFileName: string);
- var HSB,VSB: PScrollBar;
- R: TRect;
- LoadFile: boolean;
- begin
- inherited Init(Bounds,AFileName,SearchFreeWindowNo);
- Options:=Options or ofTileAble;
- GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
- New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
- GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
- New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
- GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
- New(Indicator, Init(R));
- Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
- Insert(Indicator);
- GetExtent(R); R.Grow(-1,-1);
- LoadFile:=AFileName<>'';
- if not LoadFile then
- begin SetTitle('noname'+IntToStrZ(NonameCount,2)+'.pas'); Inc(NonameCount); end;
- New(Editor, Init(R, HSB, VSB, Indicator,AFileName));
- Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
- if LoadFile then
- if Editor^.LoadFile=false then
- ErrorBox(#3'Error reading file.',nil);
- Insert(Editor);
- UpdateTitle;
- end;
- procedure TSourceWindow.UpdateTitle;
- var Name: string;
- begin
- if Editor^.FileName<>'' then
- begin Name:=SmartPath(Editor^.FileName); SetTitle(Name); end;
- end;
- procedure TSourceWindow.SetTitle(ATitle: string);
- begin
- if Title<>nil then DisposeStr(Title);
- Title:=NewStr(ATitle);
- Frame^.DrawView;
- end;
- procedure TSourceWindow.HandleEvent(var Event: TEvent);
- var DontClear: boolean;
- begin
- case Event.What of
- evBroadcast :
- case Event.Command of
- cmUpdate :
- Update;
- cmUpdateTitle :
- UpdateTitle;
- cmSearchWindow :
- if @Self<>ClipboardWindow then
- ClearEvent(Event);
- end;
- evCommand :
- begin
- DontClear:=false;
- case Event.Command of
- cmSave :
- if Editor^.IsClipboard=false then
- Editor^.Save;
- cmSaveAs :
- if Editor^.IsClipboard=false then
- Editor^.SaveAs;
- else DontClear:=true;
- end;
- if DontClear=false then ClearEvent(Event);
- end;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TSourceWindow.SetState(AState: Word; Enable: Boolean);
- var OldState: word;
- begin
- OldState:=State;
- inherited SetState(AState,Enable);
- if ((AState xor State) and sfActive)<>0 then
- UpdateCommands;
- end;
- procedure TSourceWindow.UpdateCommands;
- var Active: boolean;
- begin
- Active:=GetState(sfActive);
- if Editor^.IsClipboard=false then
- begin
- SetCmdState(SourceCmds+CompileCmds,Active);
- SetCmdState(EditorCmds,Active);
- end;
- if Active=false then
- SetCmdState(ToClipCmds+FromClipCmds+NulClipCmds+UndoCmds,false);
- Message(Application,evBroadcast,cmCommandSetChanged,nil);
- end;
- procedure TSourceWindow.Update;
- begin
- ReDraw;
- end;
- function TSourceWindow.GetPalette: PPalette;
- const P: string[length(CSourceWindow)] = CSourceWindow;
- begin
- GetPalette:=@P;
- end;
- destructor TSourceWindow.Done;
- begin
- Message(Application,evBroadcast,cmSourceWndClosing,@Self);
- inherited Done;
- Message(Application,evBroadcast,cmUpdate,@Self);
- end;
- function TGDBSourceEditor.Valid(Command: Word): Boolean;
- var OK: boolean;
- begin
- OK:=TCodeEditor.Valid(Command);
- { do NOT ask for save !!
- if OK and ((Command=cmClose) or (Command=cmQuit)) then
- if IsClipboard=false then
- OK:=SaveAsk; }
- Valid:=OK;
- end;
- procedure TGDBSourceEditor.AddLine(const S: string);
- begin
- if Silent or (IgnoreStringAtEnd and (S=LastCommand)) then exit;
- inherited AddLine(S);
- LimitsChanged;
- end;
- procedure TGDBSourceEditor.AddErrorLine(const S: string);
- begin
- if Silent then exit;
- inherited AddLine(S);
- { display like breakpoints in red }
- Lines^.At(GetLineCount-1)^.IsBreakpoint:=true;
- LimitsChanged;
- end;
- function TGDBSourceEditor.InsertLine: Sw_integer;
- Var
- S : string;
- begin
- if IsReadOnly then begin InsertLine:=-1; Exit; end;
- if CurPos.Y<GetLineCount then S:=GetLineText(CurPos.Y) else S:='';
- s:=Copy(S,1,CurPos.X);
- if assigned(Debugger) then
- if S<>'' then
- begin
- LastCommand:=S;
- { should be true only if we are at the end ! }
- IgnoreStringAtEnd:=(CurPos.Y=GetLineCount-1) and (CurPos.X=length(GetDisplayText(GetLineCount-1)));
- Debugger^.Command(S);
- IgnoreStringAtEnd:=false;
- end
- else if AutoRepeat then
- Debugger^.Command(LastCommand);
- InsertLine:=inherited InsertLine;
- end;
- constructor TGDBWindow.Init(var Bounds: TRect);
- var HSB,VSB: PScrollBar;
- R: TRect;
- begin
- inherited Init(Bounds,'GDB window',SearchFreeWindowNo);
- Options:=Options or ofTileAble;
- GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
- New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
- GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
- New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
- GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
- New(Indicator, Init(R));
- Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
- Insert(Indicator);
- GetExtent(R); R.Grow(-1,-1);
- New(Editor, Init(R, HSB, VSB, nil, GDBOutputFile));
- Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
- if ExistsFile(GDBOutputFile) then
- begin
- if Editor^.LoadFile=false then
- ErrorBox(#3'Error reading file.',nil);
- end
- else
- { Empty files are buggy !! }
- Editor^.AddLine('');
- Insert(Editor);
- if assigned(Debugger) then
- Debugger^.Command('set width '+IntToStr(Size.X-1));
- Editor^.silent:=false;
- Editor^.AutoRepeat:=true;
- end;
- destructor TGDBWindow.Done;
- begin
- if @Self=GDBWindow then
- GDBWindow:=nil;
- inherited Done;
- end;
- function TGDBWindow.GetPalette: PPalette;
- const P: string[length(CSourceWindow)] = CSourceWindow;
- begin
- GetPalette:=@P;
- end;
- procedure TGDBWindow.WriteOutputText(Buf : pchar);
- begin
- {selected normal color ?}
- WriteText(Buf,false);
- end;
- procedure TGDBWindow.WriteErrorText(Buf : pchar);
- begin
- {selected normal color ?}
- WriteText(Buf,true);
- end;
- procedure TGDBWindow.WriteString(Const S : string);
- begin
- Editor^.AddLine(S);
- end;
- procedure TGDBWindow.WriteErrorString(Const S : string);
- begin
- Editor^.AddErrorLine(S);
- end;
- procedure TGDBWindow.WriteText(Buf : pchar;IsError : boolean);
- var p,pe : pchar;
- s : string;
- begin
- p:=buf;
- DeskTop^.Lock;
- While assigned(p) do
- begin
- pe:=strscan(p,#10);
- if pe<>nil then
- pe^:=#0;
- s:=strpas(p);
- If IsError then
- Editor^.AddErrorLine(S)
- else
- Editor^.AddLine(S);
- { restore for dispose }
- if pe<>nil then
- pe^:=#10;
- if pe=nil then
- p:=nil
- else
- begin
- p:=pe;
- inc(p);
- end;
- end;
- DeskTop^.Unlock;
- Editor^.Draw;
- end;
- constructor TClipboardWindow.Init;
- var R: TRect;
- HSB,VSB: PScrollBar;
- begin
- Desktop^.GetExtent(R);
- inherited Init(R, '');
- SetTitle('Clipboard');
- HelpCtx:=hcClipboardWindow;
- Number:=wnNoNumber;
- GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
- New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
- GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
- New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
- GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
- New(Indicator, Init(R));
- Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
- Insert(Indicator);
- GetExtent(R); R.Grow(-1,-1);
- New(Editor, Init(R, HSB, VSB, Indicator, ''));
- Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
- Insert(Editor);
- Hide;
- Clipboard:=Editor;
- end;
- procedure TClipboardWindow.Show;
- begin
- inherited Show;
- if GetState(sfVisible) and (Number=0) then
- begin
- Number:=SearchFreeWindowNo;
- ReDraw;
- end;
- end;
- procedure TClipboardWindow.Hide;
- begin
- inherited Hide;
- if GetState(sfVisible)=false then Number:=0;
- end;
- procedure TClipboardWindow.Close;
- begin
- Hide;
- end;
- destructor TClipboardWindow.Done;
- begin
- inherited Done;
- Clipboard:=nil;
- ClipboardWindow:=nil;
- end;
- constructor TMessageListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
- begin
- inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
- New(ModuleNames, Init(50,100));
- NoSelection:=true;
- end;
- function TMessageListBox.GetLocalMenu: PMenu;
- var M: PMenu;
- begin
- if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
- M:=NewMenu(
- NewItem('~C~lear','',kbNoKey,cmMsgClear,hcMsgClear,
- NewLine(
- NewItem('~G~oto source','',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
- NewItem('~T~rack source','',kbNoKey,cmMsgTrackSource,hcMsgTrackSource,
- nil)))));
- GetLocalMenu:=M;
- end;
- procedure TMessageListBox.HandleEvent(var Event: TEvent);
- var DontClear: boolean;
- begin
- case Event.What of
- evKeyDown :
- begin
- DontClear:=false;
- case Event.KeyCode of
- kbEnter :
- if Owner<>pointer(SD) then
- Message(@Self,evCommand,cmMsgGotoSource,nil);
- else DontClear:=true;
- end;
- if DontClear=false then ClearEvent(Event);
- end;
- evBroadcast :
- case Event.Command of
- cmListItemSelected :
- if Event.InfoPtr=@Self then
- Message(@Self,evCommand,cmMsgTrackSource,nil);
- end;
- evCommand :
- begin
- DontClear:=false;
- case Event.Command of
- cmMsgGotoSource :
- if Range>0 then
- GotoSource;
- cmMsgTrackSource :
- if Range>0 then
- TrackSource;
- cmMsgClear :
- Clear;
- else DontClear:=true;
- end;
- if DontClear=false then ClearEvent(Event);
- end;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TMessageListBox.AddItem(P: PMessageItem);
- var W : integer;
- begin
- if List=nil then New(List, Init(500,500));
- W:=length(P^.GetText(255));
- if W>MaxWidth then
- begin
- MaxWidth:=W;
- if HScrollBar<>nil then
- HScrollBar^.SetRange(0,MaxWidth);
- end;
- List^.Insert(P);
- SetRange(List^.Count);
- if Focused=List^.Count-1-1 then
- FocusItem(List^.Count-1);
- DrawView;
- end;
- function TMessageListBox.AddModuleName(Name: string): PString;
- var P: PString;
- begin
- if ModuleNames<>nil then
- P:=ModuleNames^.Add(Name)
- else
- P:=nil;
- AddModuleName:=P;
- end;
- function TMessageListBox.GetText(Item: Integer; MaxLen: Integer): String;
- var P: PMessageItem;
- S: string;
- begin
- P:=List^.At(Item);
- S:=P^.GetText(MaxLen);
- GetText:=copy(S,1,MaxLen);
- end;
- procedure TMessageListBox.Clear;
- begin
- if List<>nil then Dispose(List, Done); List:=nil; MaxWidth:=0;
- if ModuleNames<>nil then ModuleNames^.FreeAll;
- SetRange(0); DrawView;
- Message(Application,evBroadcast,cmClearLineHighlights,@Self);
- end;
- procedure TMessageListBox.TrackSource;
- var W: PSourceWindow;
- P: PMessageItem;
- R: TRect;
- Row,Col: sw_integer;
- begin
- Message(Application,evBroadcast,cmClearLineHighlights,@Self);
- if Range=0 then Exit;
- P:=List^.At(Focused);
- if P^.Row=0 then Exit;
- Desktop^.Lock;
- GetNextEditorBounds(R);
- if Assigned(Owner) and (Owner=pointer(ProgramInfoWindow)) then
- R.B.Y:=Owner^.Origin.Y;
- if P^.Row>0 then Row:=P^.Row-1 else Row:=0;
- if P^.Col>0 then Col:=P^.Col-1 else Col:=0;
- W:=EditorWindowFile(P^.GetModuleName);
- if assigned(W) then
- begin
- W^.GetExtent(R);
- if Assigned(Owner) and (Owner=pointer(ProgramInfoWindow)) then
- R.B.Y:=Owner^.Origin.Y;
- W^.ChangeBounds(R);
- W^.Editor^.SetCurPtr(Col,Row);
- end
- else
- W:=TryToOpenFile(@R,P^.GetModuleName,Col,Row,true);
- if W<>nil then
- begin
- W^.Select;
- W^.Editor^.TrackCursor(true);
- W^.Editor^.SetHighlightRow(Row);
- end;
- if Assigned(Owner) then
- Owner^.Select;
- Desktop^.UnLock;
- end;
- procedure TMessageListBox.GotoSource;
- var W: PSourceWindow;
- P: PMessageItem;
- Row,Col: sw_integer;
- begin
- Message(Application,evBroadcast,cmClearLineHighlights,@Self);
- if Range=0 then Exit;
- P:=List^.At(Focused);
- if P^.Row=0 then Exit;
- Desktop^.Lock;
- if P^.Row>0 then Row:=P^.Row-1 else Row:=0;
- if P^.Col>0 then Col:=P^.Col-1 else Col:=0;
- W:=TryToOpenFile(nil,P^.GetModuleName,Col,Row,true);
- Message(Owner,evCommand,cmClose,nil);
- Desktop^.UnLock;
- end;
- procedure TMessageListBox.Draw;
- var
- I, J, Item: Integer;
- NormalColor, SelectedColor, FocusedColor, Color: Word;
- ColWidth, CurCol, Indent: Integer;
- B: TDrawBuffer;
- Text: String;
- SCOff: Byte;
- TC: byte;
- procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
- begin
- if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
- if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
- begin
- NormalColor := GetColor(1);
- FocusedColor := GetColor(3);
- SelectedColor := GetColor(4);
- end else
- begin
- NormalColor := GetColor(2);
- SelectedColor := GetColor(4);
- end;
- if Transparent then
- begin MT(NormalColor); MT(SelectedColor); end;
- if NoSelection then
- SelectedColor:=NormalColor;
- if HScrollBar <> nil then Indent := HScrollBar^.Value
- else Indent := 0;
- ColWidth := Size.X div NumCols + 1;
- for I := 0 to Size.Y - 1 do
- begin
- for J := 0 to NumCols-1 do
- begin
- Item := J*Size.Y + I + TopItem;
- CurCol := J*ColWidth;
- if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
- (Focused = Item) and (Range > 0) then
- begin
- Color := FocusedColor;
- SetCursor(CurCol+1,I);
- SCOff := 0;
- end
- else if (Item < Range) and IsSelected(Item) then
- begin
- Color := SelectedColor;
- SCOff := 2;
- end
- else
- begin
- Color := NormalColor;
- SCOff := 4;
- end;
- MoveChar(B[CurCol], ' ', Color, ColWidth);
- if Item < Range then
- begin
- Text := GetText(Item, ColWidth + Indent);
- Text := Copy(Text,Indent,ColWidth);
- MoveStr(B[CurCol+1], Text, Color);
- if ShowMarkers then
- begin
- WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
- WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
- end;
- end;
- MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
- end;
- WriteLine(0, I, Size.X, 1, B);
- end;
- end;
- destructor TMessageListBox.Done;
- begin
- inherited Done;
- if List<>nil then Dispose(List, Done);
- if ModuleNames<>nil then Dispose(ModuleNames, Done);
- end;
- constructor TMessageItem.Init(AClass: longint; AText: string; AModule: PString; ARow, ACol: sw_integer);
- begin
- inherited Init;
- TClass:=AClass;
- Text:=NewStr(AText);
- Module:=AModule;
- Row:=ARow; Col:=ACol;
- end;
- function TMessageItem.GetText(MaxLen: integer): string;
- var S: string;
- begin
- if Text=nil then S:='' else S:=Text^;
- if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
- GetText:=S;
- end;
- procedure TMessageItem.Selected;
- begin
- end;
- function TMessageItem.GetModuleName: string;
- begin
- GetModuleName:=GetStr(Module);
- end;
- destructor TMessageItem.Done;
- begin
- inherited Done;
- if Text<>nil then DisposeStr(Text);
- { if Module<>nil then DisposeStr(Module);}
- end;
- function TCompilerMessage.GetText(MaxLen: Integer): String;
- var ClassS: string[20];
- S: string;
- begin
- if TClass=
- V_Fatal then ClassS:='Fatal' else if TClass =
- V_Error then ClassS:='Error' else if TClass =
- V_Normal then ClassS:='' else if TClass =
- V_Warning then ClassS:='Warning' else if TClass =
- V_Note then ClassS:='Note' else if TClass =
- V_Hint then ClassS:='Hint' else if TClass =
- V_Macro then ClassS:='Macro' else if TClass =
- V_Procedure then ClassS:='Procedure' else if TClass =
- V_Conditional then ClassS:='Conditional' else if TClass =
- V_Info then ClassS:='Info' else if TClass =
- V_Status then ClassS:='Status' else if TClass =
- V_Used then ClassS:='Used' else if TClass =
- V_Tried then ClassS:='Tried' else if TClass =
- V_Debug then ClassS:='Debug'
- else
- ClassS:='???';
- if ClassS<>'' then
- ClassS:=RExpand(ClassS,0)+': ';
- S:=ClassS;
- if (Module<>nil) {and (ID<>0)} then
- S:=S+Module^+' ('+IntToStr(Row)+'): ';
- if Text<>nil then S:=ClassS+Text^;
- if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
- GetText:=S;
- end;
- constructor TProgramInfoWindow.Init;
- var R,R2: TRect;
- HSB,VSB: PScrollBar;
- ST: PStaticText;
- C: word;
- const White = 15;
- begin
- Desktop^.GetExtent(R); R.A.Y:=R.B.Y-13;
- inherited Init(R, 'Program Information', wnNoNumber);
- HelpCtx:=hcInfoWindow;
- GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+3;
- C:=((Desktop^.GetColor(32+6) and $f0) or White)*256+Desktop^.GetColor(32+6);
- New(InfoST, Init(R,'', C)); InfoST^.GrowMode:=gfGrowHiX;
- InfoST^.DontWrap:=true;
- Insert(InfoST);
- GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,3); R.B.Y:=R.A.Y+1;
- New(ST, Init(R, CharStr('Ä', MaxViewWidth))); ST^.GrowMode:=gfGrowHiX; Insert(ST);
- GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,4);
- R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
- New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
- R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
- New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
- New(LogLB, Init(R,HSB,VSB));
- LogLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
- LogLB^.Transparent:=true;
- Insert(LogLB);
- Update;
- end;
- procedure TProgramInfoWindow.AddMessage(AClass: longint; Msg, Module: string; Line, Column: longint);
- begin
- if AClass>=V_Info then Line:=0;
- LogLB^.AddItem(New(PCompilerMessage, Init(AClass, Msg, LogLB^.AddModuleName(Module), Line, Column)));
- end;
- procedure TProgramInfoWindow.ClearMessages;
- begin
- LogLB^.Clear;
- ReDraw;
- end;
- procedure TProgramInfoWindow.SizeLimits(var Min, Max: TPoint);
- begin
- inherited SizeLimits(Min,Max);
- Min.X:=30; Min.Y:=9;
- end;
- procedure TProgramInfoWindow.Close;
- begin
- Hide;
- end;
- procedure TProgramInfoWindow.HandleEvent(var Event: TEvent);
- begin
- case Event.What of
- evBroadcast :
- case Event.Command of
- cmUpdate :
- Update;
- end;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TProgramInfoWindow.Update;
- begin
- InfoST^.SetText(
- {#13+ }
- ' Current module : '+MainFile+#13+
- ' Last exit code : '+IntToStr(LastExitCode)+#13+
- ' Available memory : '+IntToStrL(MemAvail div 1024,5)+'K'+#13+
- ''
- );
- end;
- destructor TProgramInfoWindow.Done;
- begin
- inherited Done;
- ProgramInfoWindow:=nil;
- end;
- constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
- begin
- inherited Init(Bounds);
- Options:=Options or ofSelectable or ofFirstClick or ofPreProcess or ofPostProcess;
- GrowMode:=gfGrowHiX+gfGrowHiY+gfGrowRel;
- TabDefs:=ATabDef;
- ActiveDef:=-1;
- SelectTab(0);
- ReDraw;
- end;
- function TTab.TabCount: integer;
- var i: integer;
- P: PTabDef;
- begin
- I:=0; P:=TabDefs;
- while (P<>nil) do
- begin
- Inc(I);
- P:=P^.Next;
- end;
- TabCount:=I;
- end;
- function TTab.AtTab(Index: integer): PTabDef;
- var i: integer;
- P: PTabDef;
- begin
- i:=0; P:=TabDefs;
- while (I<Index) do
- begin
- if P=nil then RunError($AA);
- P:=P^.Next;
- Inc(i);
- end;
- AtTab:=P;
- end;
- procedure TTab.SelectTab(Index: integer);
- var P: PTabItem;
- V: PView;
- begin
- if ActiveDef<>Index then
- begin
- if Owner<>nil then Owner^.Lock;
- Lock;
- { --- Update --- }
- if TabDefs<>nil then
- begin
- DefCount:=1;
- while AtTab(DefCount-1)^.Next<>nil do Inc(DefCount);
- end
- else DefCount:=0;
- if ActiveDef<>-1 then
- begin
- P:=AtTab(ActiveDef)^.Items;
- while P<>nil do
- begin
- if P^.View<>nil then Delete(P^.View);
- P:=P^.Next;
- end;
- end;
- ActiveDef:=Index;
- P:=AtTab(ActiveDef)^.Items;
- while P<>nil do
- begin
- if P^.View<>nil then Insert(P^.View);
- P:=P^.Next;
- end;
- V:=AtTab(ActiveDef)^.DefItem;
- if V<>nil then V^.Select;
- ReDraw;
- { --- Update --- }
- UnLock;
- if Owner<>nil then Owner^.UnLock;
- DrawView;
- end;
- end;
- procedure TTab.ChangeBounds(var Bounds: TRect);
- var D: TPoint;
- procedure DoCalcChange(P: PView); {$ifndef FPC}far;{$endif}
- var
- R: TRect;
- begin
- if P^.Owner=nil then Exit; { it think this is a bug in TV }
- P^.CalcBounds(R, D);
- P^.ChangeBounds(R);
- end;
- var
- P: PTabItem;
- I: integer;
- begin
- D.X := Bounds.B.X - Bounds.A.X - Size.X;
- D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
- inherited ChangeBounds(Bounds);
- for I:=0 to TabCount-1 do
- if I<>ActiveDef then
- begin
- P:=AtTab(I)^.Items;
- while P<>nil do
- begin
- if P^.View<>nil then DoCalcChange(P^.View);
- P:=P^.Next;
- end;
- end;
- end;
- procedure TTab.HandleEvent(var Event: TEvent);
- var Index : integer;
- I : integer;
- X : integer;
- Len : byte;
- P : TPoint;
- V : PView;
- CallOrig: boolean;
- LastV : PView;
- FirstV: PView;
- function FirstSelectable: PView;
- var
- FV : PView;
- begin
- FV := First;
- while (FV<>nil) and ((FV^.Options and ofSelectable)=0) and (FV<>Last) do
- FV:=FV^.Next;
- if FV<>nil then
- if (FV^.Options and ofSelectable)=0 then FV:=nil;
- FirstSelectable:=FV;
- end;
- function LastSelectable: PView;
- var
- LV : PView;
- begin
- LV := Last;
- while (LV<>nil) and ((LV^.Options and ofSelectable)=0) and (LV<>First) do
- LV:=LV^.Prev;
- if LV<>nil then
- if (LV^.Options and ofSelectable)=0 then LV:=nil;
- LastSelectable:=LV;
- end;
- begin
- if (Event.What and evMouseDown)<>0 then
- begin
- MakeLocal(Event.Where,P);
- if P.Y<3 then
- begin
- Index:=-1; X:=1;
- for i:=0 to DefCount-1 do
- begin
- Len:=CStrLen(AtTab(i)^.Name^);
- if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
- X:=X+Len+3;
- end;
- if Index<>-1 then
- SelectTab(Index);
- end;
- end;
- if Event.What=evKeyDown then
- begin
- Index:=-1;
- case Event.KeyCode of
- kbTab,kbShiftTab :
- if GetState(sfSelected) then
- begin
- if Current<>nil then
- begin
- LastV:=LastSelectable; FirstV:=FirstSelectable;
- if ((Current=LastV) or (Current=PLabel(LastV)^.Link)) and (Event.KeyCode=kbShiftTab) then
- begin
- if Owner<>nil then Owner^.SelectNext(true);
- end else
- if ((Current=FirstV) or (Current=PLabel(FirstV)^.Link)) and (Event.KeyCode=kbTab) then
- begin
- Lock;
- if Owner<>nil then Owner^.SelectNext(false);
- UnLock;
- end else
- SelectNext(Event.KeyCode=kbShiftTab);
- ClearEvent(Event);
- end;
- end;
- else
- for I:=0 to DefCount-1 do
- begin
- if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut
- then begin
- Index:=I;
- ClearEvent(Event);
- Break;
- end;
- end;
- end;
- if Index<>-1 then
- begin
- Select;
- SelectTab(Index);
- V:=AtTab(ActiveDef)^.DefItem;
- if V<>nil then V^.Focus;
- end;
- end;
- CallOrig:=true;
- if Event.What=evKeyDown then
- begin
- if ((Owner<>nil) and (Owner^.Phase=phPostProcess) and (GetAltChar(Event.KeyCode)<>#0)) or GetState(sfFocused)
- then
- else CallOrig:=false;
- end;
- if CallOrig then inherited HandleEvent(Event);
- end;
- function TTab.GetPalette: PPalette;
- begin
- GetPalette:=nil;
- end;
- procedure TTab.Draw;
- var B : TDrawBuffer;
- i : integer;
- C1,C2,C3,C : word;
- HeaderLen : integer;
- X,X2 : integer;
- Name : PString;
- ActiveKPos : integer;
- ActiveVPos : integer;
- FC : char;
- ClipR : TRect;
- procedure SWriteBuf(X,Y,W,H: integer; var Buf);
- var i: integer;
- begin
- if Y+H>Size.Y then H:=Size.Y-Y;
- if X+W>Size.X then W:=Size.X-X;
- if Buffer=nil then WriteBuf(X,Y,W,H,Buf)
- else for i:=1 to H do
- Move(Buf,Buffer^[X+(Y+i-1)*Size.X],W*2);
- end;
- procedure ClearBuf;
- begin
- MoveChar(B,' ',C1,Size.X);
- end;
- begin
- if InDraw then Exit;
- InDraw:=true;
- { - Start of TGroup.Draw - }
- if Buffer = nil then
- begin
- GetBuffer;
- end;
- { - Start of TGroup.Draw - }
- C1:=GetColor(1); C2:=(GetColor(7) and $f0 or $08)+GetColor(9)*256; C3:=GetColor(8)+GetColor({9}8)*256;
- HeaderLen:=0; for i:=0 to DefCount-1 do HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name^)+3; Dec(HeaderLen);
- if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
- { --- 1. sor --- }
- ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[HeaderLen+1],'³',C1,1);
- X:=1;
- for i:=0 to DefCount-1 do
- begin
- Name:=AtTab(i)^.Name; X2:=CStrLen(Name^);
- if i=ActiveDef
- then begin
- ActiveKPos:=X-1;
- ActiveVPos:=X+X2+2;
- if GetState(sfFocused) then C:=C3 else C:=C2;
- end
- else C:=C2;
- MoveCStr(B[X],' '+Name^+' ',C); X:=X+X2+3;
- MoveChar(B[X-1],'³',C1,1);
- end;
- SWriteBuf(0,1,Size.X,1,B);
- { --- 0. sor --- }
- ClearBuf; MoveChar(B[0],'Ú',C1,1);
- X:=1;
- for i:=0 to DefCount-1 do
- begin
- if I<ActiveDef then FC:='Ú'
- else FC:='¿';
- X2:=CStrLen(AtTab(i)^.Name^)+2;
- MoveChar(B[X+X2],{'Â'}FC,C1,1);
- if i=DefCount-1 then X2:=X2+1;
- if X2>0 then
- MoveChar(B[X],'Ä',C1,X2);
- X:=X+X2+1;
- end;
- MoveChar(B[HeaderLen+1],'¿',C1,1);
- MoveChar(B[ActiveKPos],'Ú',C1,1); MoveChar(B[ActiveVPos],'¿',C1,1);
- SWriteBuf(0,0,Size.X,1,B);
- { --- 2. sor --- }
- MoveChar(B[1],'Ä',C1,Max(HeaderLen,0)); MoveChar(B[HeaderLen+2],'Ä',C1,Max(Size.X-HeaderLen-3,0));
- MoveChar(B[Size.X-1],'¿',C1,1);
- MoveChar(B[ActiveKPos],'Ù',C1,1);
- if ActiveDef=0 then MoveChar(B[0],'³',C1,1)
- else MoveChar(B[0],{'Ã'}'Ú',C1,1);
- MoveChar(B[HeaderLen+1],'Ä'{'Á'},C1,1); MoveChar(B[ActiveVPos],'À',C1,1);
- MoveChar(B[ActiveKPos+1],' ',C1,Max(ActiveVPos-ActiveKPos-1,0));
- SWriteBuf(0,2,Size.X,1,B);
- { --- marad‚k sor --- }
- ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[Size.X-1],'³',C1,1);
- SWriteBuf(0,3,Size.X,Size.Y-4,B);
- { --- Size.X . sor --- }
- MoveChar(B[0],'À',C1,1); MoveChar(B[1],'Ä',C1,Max(Size.X-2,0)); MoveChar(B[Size.X-1],'Ù',C1,1);
- SWriteBuf(0,Size.Y-1,Size.X,1,B);
- { - End of TGroup.Draw - }
- if Buffer <> nil then
- begin
- Lock;
- Redraw;
- UnLock;
- end;
- if Buffer <> nil then WriteBuf(0, 0, Size.X, Size.Y, Buffer^) else
- begin
- GetClipRect(ClipR);
- Redraw;
- GetExtent(ClipR);
- end;
- { - End of TGroup.Draw - }
- InDraw:=false;
- end;
- function TTab.Valid(Command: Word): Boolean;
- var PT : PTabDef;
- PI : PTabItem;
- OK : boolean;
- begin
- OK:=true;
- PT:=TabDefs;
- while (PT<>nil) and (OK=true) do
- begin
- PI:=PT^.Items;
- while (PI<>nil) and (OK=true) do
- begin
- if PI^.View<>nil then OK:=OK and PI^.View^.Valid(Command);
- PI:=PI^.Next;
- end;
- PT:=PT^.Next;
- end;
- Valid:=OK;
- end;
- procedure TTab.SetState(AState: Word; Enable: Boolean);
- begin
- inherited SetState(AState,Enable);
- if (AState and sfFocused)<>0 then DrawView;
- end;
- destructor TTab.Done;
- var P,X: PTabDef;
- procedure DeleteViews(P: PView); {$ifndef FPC}far;{$endif}
- begin
- if P<>nil then Delete(P);
- end;
- begin
- ForEach(@DeleteViews);
- inherited Done;
- P:=TabDefs;
- while P<>nil do
- begin
- X:=P^.Next;
- DisposeTabDef(P);
- P:=X;
- end;
- end;
- constructor TScreenView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
- AScreen: PScreen);
- begin
- inherited Init(Bounds,AHScrollBar,AVScrollBar);
- Screen:=AScreen;
- if Screen=nil then
- Fail;
- SetState(sfCursorVis,true);
- Update;
- end;
- procedure TScreenView.Update;
- begin
- SetLimit(UserScreen^.GetWidth,UserScreen^.GetHeight);
- DrawView;
- end;
- procedure TScreenView.HandleEvent(var Event: TEvent);
- begin
- case Event.What of
- evBroadcast :
- case Event.Command of
- cmUpdate : Update;
- end;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TScreenView.Draw;
- var B: TDrawBuffer;
- X,Y: integer;
- Text,Attr: string;
- P: TPoint;
- begin
- Screen^.GetCursorPos(P);
- for Y:=Delta.Y to Delta.Y+Size.Y-1 do
- begin
- if Y<Screen^.GetHeight then
- Screen^.GetLine(Y,Text,Attr)
- else
- begin Text:=''; Attr:=''; end;
- Text:=copy(Text,Delta.X+1,255); Attr:=copy(Attr,Delta.X+1,255);
- MoveChar(B,' ',0,Size.X);
- for X:=1 to length(Text) do
- MoveChar(B[X-1],Text[X],ord(Attr[X]),1);
- WriteLine(0,Y-Delta.Y,Size.X,1,B);
- end;
- SetCursor(P.X-Delta.X,P.Y-Delta.Y);
- end;
- constructor TScreenWindow.Init(AScreen: PScreen; ANumber: integer);
- var R: TRect;
- VSB,HSB: PScrollBar;
- begin
- Desktop^.GetExtent(R);
- inherited Init(R, 'User screen', ANumber);
- Options:=Options or ofTileAble;
- GetExtent(R); R.Grow(-1,-1); R.Move(1,0); R.A.X:=R.B.X-1;
- New(VSB, Init(R)); VSB^.Options:=VSB^.Options or ofPostProcess;
- VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
- GetExtent(R); R.Grow(-1,-1); R.Move(0,1); R.A.Y:=R.B.Y-1;
- New(HSB, Init(R)); HSB^.Options:=HSB^.Options or ofPostProcess;
- HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
- GetExtent(R); R.Grow(-1,-1);
- New(ScreenView, Init(R, HSB, VSB, AScreen));
- ScreenView^.GrowMode:=gfGrowHiX+gfGrowHiY;
- Insert(ScreenView);
- UserScreenWindow:=@Self;
- end;
- destructor TScreenWindow.Done;
- begin
- inherited Done;
- UserScreenWindow:=nil;
- end;
- const InTranslate : boolean = false;
- procedure TranslateMouseClick(View: PView; var Event: TEvent);
- procedure TranslateAction(Action: integer);
- var E: TEvent;
- begin
- if Action<>acNone then
- begin
- E:=Event;
- E.What:=evMouseDown; E.Buttons:=mbLeftButton;
- View^.HandleEvent(E);
- Event.What:=evCommand;
- Event.Command:=ActionCommands[Action];
- end;
- end;
- begin
- if InTranslate then Exit;
- InTranslate:=true;
- case Event.What of
- evMouseDown :
- if (GetShiftState and kbAlt)<>0 then
- TranslateAction(AltMouseAction) else
- if (GetShiftState and kbCtrl)<>0 then
- TranslateAction(CtrlMouseAction);
- end;
- InTranslate:=false;
- end;
- function GetNextEditorBounds(var Bounds: TRect): boolean;
- var P: PView;
- begin
- P:=Desktop^.First;
- while P<>nil do
- begin
- if P^.HelpCtx=hcSourceWindow then Break;
- P:=P^.NextView;
- end;
- if P=nil then Desktop^.GetExtent(Bounds) else
- begin
- P^.GetBounds(Bounds);
- Inc(Bounds.A.X); Inc(Bounds.A.Y);
- end;
- GetNextEditorBounds:=P<>nil;
- end;
- function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer): PSourceWindow;
- var R: TRect;
- W: PSourceWindow;
- begin
- if Assigned(Bounds) then R.Copy(Bounds^) else
- GetNextEditorBounds(R);
- PushStatus('Opening source file... ('+SmartPath(FileName)+')');
- New(W, Init(R, FileName));
- if W<>nil then
- begin
- if (CurX<>0) or (CurY<>0) then
- with W^.Editor^ do
- begin
- SetCurPtr(CurX,CurY);
- TrackCursor(true);
- end;
- W^.HelpCtx:=hcSourceWindow;
- Desktop^.Insert(W);
- If assigned(BreakpointCollection) then
- BreakPointCollection^.ShowBreakpoints(W);
- Message(Application,evBroadcast,cmUpdate,nil);
- end;
- PopStatus;
- OpenEditorWindow:=W;
- end;
- function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts:boolean): PSourceWindow;
- var D : DirStr;
- N : NameStr;
- E : ExtStr;
- DrStr : String;
- function CheckDir(NewDir: DirStr; NewName: NameStr; NewExt: ExtStr): boolean;
- var OK: boolean;
- begin
- NewDir:=CompleteDir(NewDir);
- OK:=ExistsFile(NewDir+NewName+NewExt);
- if OK then begin D:=NewDir; N:=NewName; E:=NewExt; end;
- CheckDir:=OK;
- end;
- function CheckExt(NewExt: ExtStr): boolean;
- var OK: boolean;
- begin
- OK:=false;
- if D<>'' then OK:=CheckDir(D,N,NewExt) else
- if CheckDir('.'+DirSep,N,NewExt) then OK:=true;
- CheckExt:=OK;
- end;
- function TryToOpen(const DD : dirstr): PSourceWindow;
- var Found: boolean;
- W : PSourceWindow;
- begin
- D:=CompleteDir(DD);
- Found:=true;
- if (E<>'') or (not tryexts) then
- Found:=CheckExt(E)
- else
- if CheckExt('.pp') then
- Found:=true
- else
- if CheckExt('.pas') then
- Found:=true
- else
- if CheckExt('.inc') then
- Found:=true
- else
- Found:=false;
- if Found=false then
- W:=nil
- else
- begin
- FileName:=FExpand(D+N+E);
- W:=OpenEditorWindow(Bounds,FileName,CurX,CurY);
- end;
- TryToOpen:=W;
- end;
- function SearchOnDesktop: PSourceWindow;
- var W: PWindow;
- I: integer;
- Found: boolean;
- SName : string;
- begin
- for I:=1 to 100 do
- begin
- W:=SearchWindowWithNo(I);
- if (W<>nil) and (W^.HelpCtx=hcSourceWindow) then
- begin
- if (D='') then
- SName:=NameAndExtOf(PSourceWindow(W)^.Editor^.FileName)
- else
- SName:=PSourceWindow(W)^.Editor^.FileName;
- SName:=UpcaseStr(SName);
- if E<>'' then
- begin
- if D<>'' then
- Found:=SName=UpcaseStr(D+N+E)
- else
- Found:=SName=UpcaseStr(N+E);
- end
- else
- begin
- Found:=SName=UpcaseStr(N+'.pp');
- if Found=false then
- Found:=SName=UpcaseStr(N+'.pas');
- end;
- if Found then Break;
- end;
- end;
- if Found=false then W:=nil;
- SearchOnDesktop:=PSourceWindow(W);
- end;
- var
- W : PSourceWindow;
- begin
- FSplit(FileName,D,N,E);
- W:=SearchOnDesktop;
- if W<>nil then
- begin
- NewEditorOpened:=false;
- { if assigned(Bounds) then
- W^.ChangeBounds(Bounds^);}
- W^.Editor^.SetCurPtr(CurX,CurY);
- end
- else
- begin
- DrStr:=GetSourceDirectories;
- While pos(';',DrStr)>0 do
- Begin
- W:=TryToOpen(Copy(DrStr,1,pos(';',DrStr)-1));
- if assigned(W) then
- break;
- DrStr:=Copy(DrStr,pos(';',DrStr)+1,255);
- End;
- if not assigned(W) then
- W:=TryToOpen(DrStr);
- NewEditorOpened:=W<>nil;
- if assigned(W) then
- W^.Editor^.SetCurPtr(CurX,CurY);
- end;
- TryToOpenFile:=W;
- end;
- function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
- var OK: boolean;
- E: PFileEditor;
- R: TRect;
- begin
- R.Assign(0,0,0,0);
- New(E, Init(R,nil,nil,nil,FileName));
- OK:=E<>nil;
- if OK then OK:=E^.LoadFile;
- if OK then
- begin
- E^.SelectAll(true);
- Editor^.InsertFrom(E);
- Editor^.SetCurPtr(0,0);
- Editor^.SelectAll(false);
- Dispose(E, Done);
- end;
- StartEditor:=OK;
- end;
- constructor TTextScroller.Init(var Bounds: TRect; ASpeed: integer; AText: PUnsortedStringCollection);
- begin
- inherited Init(Bounds,'');
- EventMask:=EventMask or evIdle;
- Speed:=ASpeed; Lines:=AText;
- end;
- function TTextScroller.GetLineCount: integer;
- var Count: integer;
- begin
- if Lines=nil then Count:=0 else
- Count:=Lines^.Count;
- GetLineCount:=Count;
- end;
- function TTextScroller.GetLine(I: integer): string;
- var S: string;
- begin
- if I<Lines^.Count then
- S:=GetStr(Lines^.At(I))
- else
- S:='';
- GetLine:=S;
- end;
- procedure TTextScroller.HandleEvent(var Event: TEvent);
- begin
- case Event.What of
- evIdle :
- Update;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TTextScroller.Update;
- begin
- if abs(GetDosTicks-LastTT)<Speed then Exit;
- Scroll;
- LastTT:=GetDosTicks;
- end;
- procedure TTextScroller.Reset;
- begin
- TopLine:=0;
- LastTT:=GetDosTicks;
- DrawView;
- end;
- procedure TTextScroller.Scroll;
- begin
- Inc(TopLine);
- if TopLine>=GetLineCount then
- Reset;
- DrawView;
- end;
- procedure TTextScroller.Draw;
- var B: TDrawBuffer;
- C: word;
- Count,Y: integer;
- S: string;
- begin
- C:=GetColor(1);
- Count:=GetLineCount;
- for Y:=0 to Size.Y-1 do
- begin
- if Count=0 then S:='' else
- S:=GetLine((TopLine+Y) mod Count);
- if copy(S,1,1)=^C then
- S:=CharStr(' ',Max(0,(Size.X-(length(S)-1)) div 2))+copy(S,2,255);
- MoveChar(B,' ',C,Size.X);
- MoveStr(B,S,C);
- WriteLine(0,Y,Size.X,1,B);
- end;
- end;
- destructor TTextScroller.Done;
- begin
- inherited Done;
- if Lines<>nil then Dispose(Lines, Done);
- end;
- constructor TFPAboutDialog.Init;
- var R,R2: TRect;
- C: PUnsortedStringCollection;
- I: integer;
- OSStr: string;
- procedure AddLine(S: string);
- begin
- C^.Insert(NewStr(S));
- end;
- begin
- OSStr:='';
- {$ifdef go32v2}
- OSStr:='Dos';
- {$endif}
- {$ifdef tp}
- OSStr:='Dos';
- {$endif}
- {$ifdef linux}
- OSStr:='Linux';
- {$endif}
- {$ifdef win32}
- OSStr:='Win32';
- {$endif}
- {$ifdef os2}
- OSStr:='OS/2';
- {$endif}
- R.Assign(0,0,38,12);
- inherited Init(R, 'About');
- GetExtent(R); R.Grow(-3,-2);
- R2.Copy(R); R2.B.Y:=R2.A.Y+1;
- Insert(New(PStaticText, Init(R2, ^C'FreePascal IDE for '+OSStr)));
- R2.Move(0,1);
- Insert(New(PStaticText, Init(R2, ^C' Version '+VersionStr)));
- R2.Move(0,1);
- Insert(New(PStaticText, Init(R2, ^C'(Compiler Version '+Version_String+')')));
- R2.Move(0,2);
- Insert(New(PStaticText, Init(R2, ^C'Copyright (C) 1998-99 by')));
- R2.Move(0,2);
- Insert(New(PStaticText, Init(R2, ^C'B‚rczi G bor')));
- R2.Move(0,1);
- Insert(New(PStaticText, Init(R2, ^C'and')));
- R2.Move(0,1);
- Insert(New(PStaticText, Init(R2, ^C'Peter Vreman')));
- New(C, Init(50,10));
- for I:=1 to 7 do
- AddLine('');
- AddLine(^C'< Original concept >');
- AddLine(^C'Borland International, Inc.');
- AddLine('');
- AddLine(^C'< Compiler development >');
- AddLine(^C'Carl-Eric Codere');
- AddLine(^C'Daniel Mantione');
- AddLine(^C'Florian Kl„mpfl');
- AddLine(^C'Jonas Maebe');
- AddLine(^C'Mich„el Van Canneyt');
- AddLine(^C'Peter Vreman');
- AddLine(^C'Pierre Muller');
- AddLine('');
- AddLine(^C'< IDE development >');
- AddLine(^C'B‚rczi G bor');
- AddLine(^C'Peter Vreman');
- AddLine(^C'Pierre Muller');
- AddLine('');
- GetExtent(R);
- R.Grow(-1,-1); Inc(R.A.Y,3);
- New(Scroller, Init(R, 10, C));
- Scroller^.Hide;
- Insert(Scroller);
- R.Move(0,-1); R.B.Y:=R.A.Y+1;
- New(TitleST, Init(R, ^C'Team'));
- TitleST^.Hide;
- Insert(TitleST);
- InsertOK(@Self);
- end;
- procedure TFPAboutDialog.ToggleInfo;
- begin
- if Scroller=nil then Exit;
- if Scroller^.GetState(sfVisible) then
- begin
- Scroller^.Hide;
- TitleST^.Hide;
- end
- else
- begin
- Scroller^.Reset;
- Scroller^.Show;
- TitleST^.Show;
- end;
- end;
- procedure TFPAboutDialog.HandleEvent(var Event: TEvent);
- begin
- case Event.What of
- evKeyDown :
- case Event.KeyCode of
- kbAltI : { just like in BP }
- begin
- ToggleInfo;
- ClearEvent(Event);
- end;
- end;
- end;
- inherited HandleEvent(Event);
- end;
- constructor TFPASCIIChart.Init;
- begin
- inherited Init;
- HelpCtx:=hcASCIITable;
- Number:=SearchFreeWindowNo;
- ASCIIChart:=@Self;
- end;
- procedure TFPASCIIChart.HandleEvent(var Event: TEvent);
- begin
- case Event.What of
- evKeyDown :
- case Event.KeyCode of
- kbEsc :
- begin
- Close;
- ClearEvent(Event);
- end;
- end;
- end;
- inherited HandleEvent(Event);
- end;
- destructor TFPASCIIChart.Done;
- begin
- ASCIIChart:=nil;
- inherited Done;
- end;
- END.
- {
- $Log$
- Revision 1.22 1999-03-16 00:44:45 peter
- * forgotten in last commit :(
- Revision 1.21 1999/03/08 14:58:16 peter
- + prompt with dialogs for tools
- Revision 1.20 1999/03/01 15:42:08 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
- * efBackSpaceUnindents works correctly
- + 'Messages' window implemented
- + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
- + Added TP message-filter support (for ex. you can call GREP thru
- GREP2MSG and view the result in the messages window - just like in TP)
- * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
- so topic search didn't work...
- * In FPHELP.PAS there were still context-variables defined as word instead
- of THelpCtx
- * StdStatusKeys() was missing from the statusdef for help windows
- + Topic-title for index-table can be specified when adding a HTML-files
- Revision 1.19 1999/02/22 11:51:39 peter
- * browser updates from gabor
- Revision 1.18 1999/02/22 11:29:38 pierre
- + added col info in MessageItem
- + grep uses HighLightExts and should work for linux
- Revision 1.17 1999/02/22 02:15:22 peter
- + default extension for save in the editor
- + Separate Text to Find for the grep dialog
- * fixed redir crash with tp7
- Revision 1.16 1999/02/19 18:43:49 peter
- + open dialog supports mask list
- Revision 1.15 1999/02/17 15:04:02 pierre
- + file(line) added in TProgramInfo message list
- Revision 1.14 1999/02/16 12:45:18 pierre
- * GDBWindow size and grow corrected
- Revision 1.13 1999/02/15 09:36:06 pierre
- * // comment ends at end of line !
- GDB window changed !
- now all is in a normal text editor, but pressing
- Enter key will send part of line before cursor to GDB !
- Revision 1.12 1999/02/11 19:07:25 pierre
- * GDBWindow redesigned :
- normal editor apart from
- that any kbEnter will send the line (for begin to cursor)
- to GDB command !
- GDBWindow opened in Debugger Menu
- still buggy :
- -echo should not be present if at end of text
- -GDBWindow becomes First after each step (I don't know why !)
- Revision 1.11 1999/02/11 13:08:39 pierre
- + TGDBWindow : direct gdb input/output
- Revision 1.10 1999/02/10 09:42:52 pierre
- + DoneReservedWords to avoid memory leaks
- * TMessageItem Module field was not disposed
- Revision 1.9 1999/02/05 12:12:02 pierre
- + SourceDir that stores directories for sources that the
- compiler should not know about
- Automatically asked for addition when a new file that
- needed filedialog to be found is in an unknown directory
- Stored and retrieved from INIFile
- + Breakpoints conditions added to INIFile
- * Breakpoints insterted and removed at debin and end of debug session
- Revision 1.8 1999/02/04 17:45:23 pierre
- + BrowserAtCursor started
- * bug in TryToOpenFile removed
- Revision 1.7 1999/02/04 13:32:11 pierre
- * Several things added (I cannot commit them independently !)
- + added TBreakpoint and TBreakpointCollection
- + added cmResetDebugger,cmGrep,CmToggleBreakpoint
- + Breakpoint list in INIFile
- * Select items now also depend of SwitchMode
- * Reading of option '-g' was not possible !
- + added search for -Fu args pathes in TryToOpen
- + added code for automatic opening of FileDialog
- if source not found
- Revision 1.6 1999/01/21 11:54:27 peter
- + tools menu
- + speedsearch in symbolbrowser
- * working run command
- Revision 1.5 1999/01/14 21:42:25 peter
- * source tracking from Gabor
- Revision 1.4 1999/01/12 14:29:42 peter
- + Implemented still missing 'switch' entries in Options menu
- + Pressing Ctrl-B sets ASCII mode in editor, after which keypresses (even
- ones with ASCII < 32 ; entered with Alt+<###>) are interpreted always as
- ASCII chars and inserted directly in the text.
- + Added symbol browser
- * splitted fp.pas to fpide.pas
- Revision 1.3 1999/01/04 11:49:53 peter
- * 'Use tab characters' now works correctly
- + Syntax highlight now acts on File|Save As...
- + Added a new class to syntax highlight: 'hex numbers'.
- * There was something very wrong with the palette managment. Now fixed.
- + Added output directory (-FE<xxx>) support to 'Directories' dialog...
- * Fixed some possible bugs in Running/Compiling, and the compilation/run
- process revised
- Revision 1.2 1998/12/28 15:47:54 peter
- + Added user screen support, display & window
- + Implemented Editor,Mouse Options dialog
- + Added location of .INI and .CFG file
- + Option (INI) file managment implemented (see bottom of Options Menu)
- + Switches updated
- + Run program
- Revision 1.4 1998/12/22 10:39:53 peter
- + options are now written/read
- + find and replace routines
- }
|