fpviews.pas 107 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998 by Berczi Gabor
  5. Views and view-related functions for the IDE
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit FPViews;
  13. {$i globdir.inc}
  14. interface
  15. uses
  16. Dos,Objects,Drivers,Commands,HelpCtx,Views,Menus,Dialogs,App,Gadgets,
  17. ASCIITAB,
  18. {$ifdef EDITORS}
  19. Editors,
  20. {$else}
  21. WEditor,WCEdit,
  22. {$endif}
  23. WUtils,WHelp,WHlpView,WViews,WANSI,
  24. Comphook,
  25. FPConst,FPUsrScr;
  26. type
  27. {$IFNDEF EDITORS}
  28. TEditor = TCodeEditor; PEditor = PCodeEditor;
  29. {$ENDIF}
  30. PStoreCollection = ^TStoreCollection;
  31. TStoreCollection = object(TStringCollection)
  32. function Add(const S: string): PString;
  33. end;
  34. PIntegerLine = ^TIntegerLine;
  35. TIntegerLine = object(TInputLine)
  36. constructor Init(var Bounds: TRect; AMin, AMax: longint);
  37. end;
  38. PFPHeapView = ^TFPHeapView;
  39. TFPHeapView = object(THeapView)
  40. constructor Init(var Bounds: TRect);
  41. constructor InitKb(var Bounds: TRect);
  42. procedure HandleEvent(var Event: TEvent); virtual;
  43. end;
  44. PFPClockView = ^TFPClockView;
  45. TFPClockView = object(TClockView)
  46. constructor Init(var Bounds: TRect);
  47. procedure HandleEvent(var Event: TEvent); virtual;
  48. function GetPalette: PPalette; virtual;
  49. end;
  50. TFPWindow = object(TWindow)
  51. AutoNumber: boolean;
  52. procedure HandleEvent(var Event: TEvent); virtual;
  53. procedure SetState(AState: Word; Enable: Boolean); virtual;
  54. constructor Load(var S: TStream);
  55. procedure Store(var S: TStream);
  56. procedure Update; virtual;
  57. end;
  58. PFPHelpViewer = ^TFPHelpViewer;
  59. TFPHelpViewer = object(THelpViewer)
  60. function GetLocalMenu: PMenu; virtual;
  61. function GetCommandTarget: PView; virtual;
  62. end;
  63. PFPHelpWindow = ^TFPHelpWindow;
  64. TFPHelpWindow = object(THelpWindow)
  65. constructor Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word; AContext: THelpCtx; ANumber: Integer);
  66. destructor Done;virtual;
  67. procedure InitHelpView; virtual;
  68. procedure Show; {virtual;}
  69. procedure Hide; {virtual;}
  70. procedure HandleEvent(var Event: TEvent); virtual;
  71. function GetPalette: PPalette; virtual;
  72. constructor Load(var S: TStream);
  73. procedure Store(var S: TStream);
  74. end;
  75. PTextScroller = ^TTextScroller;
  76. TTextScroller = object(TStaticText)
  77. TopLine: integer;
  78. Speed : integer;
  79. Lines : PUnsortedStringCollection;
  80. constructor Init(var Bounds: TRect; ASpeed: integer; AText: PUnsortedStringCollection);
  81. function GetLineCount: integer; virtual;
  82. function GetLine(I: integer): string; virtual;
  83. procedure HandleEvent(var Event: TEvent); virtual;
  84. procedure Update; virtual;
  85. procedure Reset; virtual;
  86. procedure Scroll; virtual;
  87. procedure Draw; virtual;
  88. destructor Done; virtual;
  89. private
  90. LastTT: longint;
  91. end;
  92. TAlign = (alLeft,alCenter,alRight);
  93. PFPToolTip = ^TFPToolTip;
  94. TFPToolTip = object(TView)
  95. constructor Init(var Bounds: TRect; const AText: string; AAlign: TAlign);
  96. procedure Draw; virtual;
  97. function GetText: string;
  98. procedure SetText(const AText: string);
  99. function GetAlign: TAlign;
  100. procedure SetAlign(AAlign: TAlign);
  101. function GetPalette: PPalette; virtual;
  102. destructor Done; virtual;
  103. private
  104. Text: PString;
  105. Align: TAlign;
  106. end;
  107. PSourceEditor = ^TSourceEditor;
  108. TSourceEditor = object(TFileEditor)
  109. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  110. PScrollBar; AIndicator: PIndicator;const AFileName: string);
  111. CompileStamp : longint;
  112. {$ifndef EDITORS}
  113. public
  114. CodeCompleteTip: PFPToolTip;
  115. { Syntax highlight }
  116. function IsReservedWord(const S: string): boolean; virtual;
  117. function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
  118. function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
  119. { CodeTemplates }
  120. function TranslateCodeTemplate(const Shortcut: string; ALines: PUnsortedStringCollection): boolean; virtual;
  121. { CodeComplete }
  122. function CompleteCodeWord(const WordS: string; var Text: string): boolean; virtual;
  123. procedure SetCodeCompleteWord(const S: string); virtual;
  124. procedure AlignCodeCompleteTip;
  125. {$endif}
  126. procedure HandleEvent(var Event: TEvent); virtual;
  127. {$ifdef DebugUndo}
  128. procedure DumpUndo;
  129. procedure UndoAll;
  130. procedure RedoAll;
  131. {$endif DebugUndo}
  132. function GetLocalMenu: PMenu; virtual;
  133. function GetCommandTarget: PView; virtual;
  134. function CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup; virtual;
  135. procedure ModifiedChanged; virtual;
  136. procedure InsertOptions; virtual;
  137. end;
  138. PSourceWindow = ^TSourceWindow;
  139. TSourceWindow = object(TFPWindow)
  140. Editor : PSourceEditor;
  141. Indicator : PIndicator;
  142. constructor Init(var Bounds: TRect; AFileName: string);
  143. function GetTitle(MaxSize: sw_Integer): TTitleStr; virtual;
  144. procedure SetTitle(ATitle: string); virtual;
  145. procedure UpdateTitle; virtual;
  146. procedure HandleEvent(var Event: TEvent); virtual;
  147. procedure SetState(AState: Word; Enable: Boolean); virtual;
  148. procedure SelectInDebugSession;
  149. procedure Update; virtual;
  150. procedure UpdateCommands; virtual;
  151. function GetPalette: PPalette; virtual;
  152. constructor Load(var S: TStream);
  153. procedure Store(var S: TStream);
  154. procedure Close; virtual;
  155. destructor Done; virtual;
  156. end;
  157. PGDBSourceEditor = ^TGDBSourceEditor;
  158. TGDBSourceEditor = object(TSourceEditor)
  159. function InsertNewLine : Sw_integer;virtual;
  160. function Valid(Command: Word): Boolean; virtual;
  161. procedure AddLine(const S: string); virtual;
  162. procedure AddErrorLine(const S: string); virtual;
  163. { Syntax highlight }
  164. function IsReservedWord(const S: string): boolean; virtual;
  165. private
  166. Silent,
  167. AutoRepeat,
  168. IgnoreStringAtEnd : boolean;
  169. LastCommand : String;
  170. end;
  171. PGDBWindow = ^TGDBWindow;
  172. TGDBWindow = object(TFPWindow)
  173. Editor : PGDBSourceEditor;
  174. Indicator : PIndicator;
  175. constructor Init(var Bounds: TRect);
  176. procedure WriteText(Buf : pchar;IsError : boolean);
  177. procedure WriteString(Const S : string);
  178. procedure WriteErrorString(Const S : string);
  179. procedure WriteOutputText(Buf : pchar);
  180. procedure WriteErrorText(Buf : pchar);
  181. function GetPalette: PPalette;virtual;
  182. constructor Load(var S: TStream);
  183. procedure Store(var S: TStream);
  184. procedure SetState(AState: Word; Enable: Boolean); virtual;
  185. procedure UpdateCommands; virtual;
  186. destructor Done; virtual;
  187. end;
  188. PClipboardWindow = ^TClipboardWindow;
  189. TClipboardWindow = object(TSourceWindow)
  190. constructor Init;
  191. procedure Close; virtual;
  192. constructor Load(var S: TStream);
  193. procedure Store(var S: TStream);
  194. destructor Done; virtual;
  195. end;
  196. PMessageItem = ^TMessageItem;
  197. TMessageItem = object(TObject)
  198. TClass : longint;
  199. Text : PString;
  200. Module : PString;
  201. Row,Col : sw_integer;
  202. constructor Init(AClass: longint; const AText: string; AModule: PString; ARow, ACol: sw_integer);
  203. function GetText(MaxLen: Sw_integer): string; virtual;
  204. procedure Selected; virtual;
  205. function GetModuleName: string; virtual;
  206. destructor Done; virtual;
  207. end;
  208. PMessageListBox = ^TMessageListBox;
  209. TMessageListBox = object(THSListBox)
  210. Transparent : boolean;
  211. NoSelection : boolean;
  212. MaxWidth : Sw_integer;
  213. ModuleNames : PStoreCollection;
  214. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  215. procedure AddItem(P: PMessageItem); virtual;
  216. function AddModuleName(const Name: string): PString; virtual;
  217. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  218. procedure Clear; virtual;
  219. procedure TrackSource; virtual;
  220. procedure GotoSource; virtual;
  221. procedure Draw; virtual;
  222. procedure HandleEvent(var Event: TEvent); virtual;
  223. function GetLocalMenu: PMenu; virtual;
  224. constructor Load(var S: TStream);
  225. procedure Store(var S: TStream);
  226. destructor Done; virtual;
  227. end;
  228. {$ifdef OLDCOMP}
  229. PCompilerMessage = ^TCompilerMessage;
  230. TCompilerMessage = object(TMessageItem)
  231. function GetText(MaxLen: Sw_Integer): String; virtual;
  232. end;
  233. {$endif}
  234. PProgramInfoWindow = ^TProgramInfoWindow;
  235. TProgramInfoWindow = object(TDlgWindow)
  236. InfoST: PColorStaticText;
  237. LogLB : PMessageListBox;
  238. constructor Init;
  239. constructor Load(var S: TStream);
  240. procedure Store(var S: TStream);
  241. procedure AddMessage(AClass: longint; Msg, Module: string; Line, Column: longint);
  242. procedure ClearMessages;
  243. procedure SizeLimits(var Min, Max: TPoint); virtual;
  244. procedure Close; virtual;
  245. procedure HandleEvent(var Event: TEvent); virtual;
  246. procedure Update; virtual;
  247. destructor Done; virtual;
  248. end;
  249. PTabItem = ^TTabItem;
  250. TTabItem = record
  251. Next : PTabItem;
  252. View : PView;
  253. Dis : boolean;
  254. end;
  255. PTabDef = ^TTabDef;
  256. TTabDef = record
  257. Next : PTabDef;
  258. Name : PString;
  259. Items : PTabItem;
  260. DefItem : PView;
  261. ShortCut : char;
  262. end;
  263. PTab = ^TTab;
  264. TTab = object(TGroup)
  265. TabDefs : PTabDef;
  266. ActiveDef : integer;
  267. DefCount : word;
  268. constructor Init(var Bounds: TRect; ATabDef: PTabDef);
  269. function AtTab(Index: integer): PTabDef; virtual;
  270. procedure SelectTab(Index: integer); virtual;
  271. function TabCount: integer;
  272. procedure SelectNextTab(Forwards: boolean);
  273. function Valid(Command: Word): Boolean; virtual;
  274. procedure ChangeBounds(var Bounds: TRect); virtual;
  275. procedure HandleEvent(var Event: TEvent); virtual;
  276. function GetPalette: PPalette; virtual;
  277. procedure Draw; virtual;
  278. procedure SetState(AState: Word; Enable: Boolean); virtual;
  279. destructor Done; virtual;
  280. private
  281. InDraw: boolean;
  282. end;
  283. PScreenView = ^TScreenView;
  284. TScreenView = object(TScroller)
  285. Screen: PScreen;
  286. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  287. AScreen: PScreen);
  288. procedure Draw; virtual;
  289. procedure Update; virtual;
  290. procedure HandleEvent(var Event: TEvent); virtual;
  291. end;
  292. PScreenWindow = ^TScreenWindow;
  293. TScreenWindow = object(TFPWindow)
  294. ScreenView : PScreenView;
  295. constructor Init(AScreen: PScreen; ANumber: integer);
  296. destructor Done; virtual;
  297. end;
  298. PFPAboutDialog = ^TFPAboutDialog;
  299. TFPAboutDialog = object(TCenterDialog)
  300. constructor Init;
  301. procedure ToggleInfo;
  302. procedure HandleEvent(var Event: TEvent); virtual;
  303. private
  304. Scroller: PTextScroller;
  305. TitleST : PStaticText;
  306. end;
  307. PFPASCIIChart = ^TFPASCIIChart;
  308. TFPASCIIChart = object(TASCIIChart)
  309. constructor Init;
  310. constructor Load(var S: TStream);
  311. procedure Store(var S: TStream);
  312. procedure HandleEvent(var Event: TEvent); virtual;
  313. destructor Done; virtual;
  314. end;
  315. PVideoModeListBox = ^TVideoModeListBox;
  316. TVideoModeListBox = object(TDropDownListBox)
  317. function GetText(Item: pointer; MaxLen: sw_integer): string; virtual;
  318. end;
  319. PFPDesktop = ^TFPDesktop;
  320. TFPDesktop = object(TDesktop)
  321. constructor Init(var Bounds: TRect);
  322. procedure InitBackground; virtual;
  323. constructor Load(var S: TStream);
  324. procedure Store(var S: TStream);
  325. end;
  326. PFPMemo = ^TFPMemo;
  327. TFPMemo = object(TCodeEditor)
  328. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  329. PScrollBar; AIndicator: PIndicator);
  330. function IsReservedWord(const S: string): boolean; virtual;
  331. function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
  332. function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
  333. function GetPalette: PPalette; virtual;
  334. end;
  335. PFPCodeMemo = ^TFPCodeMemo;
  336. TFPCodeMemo = object(TFPMemo)
  337. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  338. PScrollBar; AIndicator: PIndicator);
  339. function IsReservedWord(const S: string): boolean; virtual;
  340. function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
  341. function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
  342. end;
  343. function SearchFreeWindowNo: integer;
  344. function IsWindow(P: PView): boolean;
  345. function IsThereAnyEditor: boolean;
  346. function IsThereAnyWindow: boolean;
  347. function IsThereAnyVisibleWindow: boolean;
  348. function IsThereAnyNumberedWindow: boolean;
  349. function FirstEditorWindow: PSourceWindow;
  350. function EditorWindowFile(const Name : String): PSourceWindow;
  351. function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
  352. procedure DisposeTabItem(P: PTabItem);
  353. function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
  354. procedure DisposeTabDef(P: PTabDef);
  355. function GetEditorCurWord(Editor: PEditor; ValidSpecChars: TCharSet): string;
  356. procedure InitReservedWords;
  357. procedure DoneReservedWords;
  358. function GetReservedWordCount: integer;
  359. function GetReservedWord(Index: integer): string;
  360. procedure TranslateMouseClick(View: PView; var Event: TEvent);
  361. function GetNextEditorBounds(var Bounds: TRect): boolean;
  362. function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer): PSourceWindow;
  363. function IOpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer; ShowIt: boolean): PSourceWindow;
  364. function SearchOnDesktop(FileName : string;tryexts:boolean) : PSourceWindow;
  365. function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts: boolean): PSourceWindow;
  366. function ITryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts, ShowIt,
  367. ForceNewWindow:boolean): PSourceWindow;
  368. function LocateSourceFile(const FileName: string; tryexts: boolean): string;
  369. function SearchWindow(const Title: string): PWindow;
  370. function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
  371. {$ifdef VESA}
  372. procedure InitVESAScreenModes;
  373. {$endif}
  374. procedure NoDebugger;
  375. const
  376. SourceCmds : TCommandSet =
  377. ([cmSave,cmSaveAs,cmCompile,cmHide]);
  378. EditorCmds : TCommandSet =
  379. ([cmFind,cmReplace,cmSearchAgain,cmJumpLine,cmHelpTopicSearch]);
  380. CompileCmds : TCommandSet =
  381. ([cmMake,cmBuild,cmRun]);
  382. CalcClipboard : extended = 0;
  383. OpenFileName : string{$ifdef GABOR}[50]{$endif} = '';
  384. OpenFileLastExt : string[12] = '*.pas';
  385. NewEditorOpened : boolean = false;
  386. var MsgParms : array[1..10] of
  387. record
  388. case byte of
  389. 0 : (Ptr : pointer);
  390. 1 : (Long: longint);
  391. end;
  392. procedure RegisterFPViews;
  393. implementation
  394. uses
  395. Video,Strings,Keyboard,Validate,
  396. globtype,Tokens,Version,
  397. {$ifndef NODEBUG}
  398. gdbint,
  399. {$endif NODEBUG}
  400. {$ifdef VESA}Vesa,{$endif}
  401. FPString,FPSwitch,FPSymbol,FPDebug,FPVars,FPUtils,FPCompil,FPHelp,
  402. FPTools,FPIDE,FPCodTmp,FPCodCmp;
  403. const
  404. RSourceEditor: TStreamRec = (
  405. ObjType: 1500;
  406. VmtLink: Ofs(TypeOf(TSourceEditor)^);
  407. Load: @TSourceEditor.Load;
  408. Store: @TSourceEditor.Store
  409. );
  410. RSourceWindow: TStreamRec = (
  411. ObjType: 1501;
  412. VmtLink: Ofs(TypeOf(TSourceWindow)^);
  413. Load: @TSourceWindow.Load;
  414. Store: @TSourceWindow.Store
  415. );
  416. RFPHelpViewer: TStreamRec = (
  417. ObjType: 1502;
  418. VmtLink: Ofs(TypeOf(TFPHelpViewer)^);
  419. Load: @TFPHelpViewer.Load;
  420. Store: @TFPHelpViewer.Store
  421. );
  422. RFPHelpWindow: TStreamRec = (
  423. ObjType: 1503;
  424. VmtLink: Ofs(TypeOf(TFPHelpWindow)^);
  425. Load: @TFPHelpWindow.Load;
  426. Store: @TFPHelpWindow.Store
  427. );
  428. RClipboardWindow: TStreamRec = (
  429. ObjType: 1504;
  430. VmtLink: Ofs(TypeOf(TClipboardWindow)^);
  431. Load: @TClipboardWindow.Load;
  432. Store: @TClipboardWindow.Store
  433. );
  434. RMessageListBox: TStreamRec = (
  435. ObjType: 1505;
  436. VmtLink: Ofs(TypeOf(TMessageListBox)^);
  437. Load: @TMessageListBox.Load;
  438. Store: @TMessageListBox.Store
  439. );
  440. RFPDesktop: TStreamRec = (
  441. ObjType: 1506;
  442. VmtLink: Ofs(TypeOf(TFPDesktop)^);
  443. Load: @TFPDesktop.Load;
  444. Store: @TFPDesktop.Store
  445. );
  446. RGDBSourceEditor: TStreamRec = (
  447. ObjType: 1507;
  448. VmtLink: Ofs(TypeOf(TGDBSourceEditor)^);
  449. Load: @TGDBSourceEditor.Load;
  450. Store: @TGDBSourceEditor.Store
  451. );
  452. RGDBWindow: TStreamRec = (
  453. ObjType: 1508;
  454. VmtLink: Ofs(TypeOf(TGDBWindow)^);
  455. Load: @TGDBWindow.Load;
  456. Store: @TGDBWindow.Store
  457. );
  458. RFPASCIIChart: TStreamRec = (
  459. ObjType: 1509;
  460. VmtLink: Ofs(TypeOf(TFPASCIIChart)^);
  461. Load: @TFPASCIIChart.Load;
  462. Store: @TFPASCIIChart.Store
  463. );
  464. RProgramInfoWindow: TStreamRec = (
  465. ObjType: 1510;
  466. VmtLink: Ofs(TypeOf(TProgramInfoWindow)^);
  467. Load: @TProgramInfoWindow.Load;
  468. Store: @TProgramInfoWindow.Store
  469. );
  470. const
  471. NoNameCount : integer = 0;
  472. var
  473. ReservedWords : array[1..ReservedWordMaxLen] of PStringCollection;
  474. {****************************************************************************
  475. TStoreCollection
  476. ****************************************************************************}
  477. function TStoreCollection.Add(const S: string): PString;
  478. var P: PString;
  479. Index: Sw_integer;
  480. begin
  481. if S='' then P:=nil else
  482. if Search(@S,Index) then P:=At(Index) else
  483. begin
  484. P:=NewStr(S);
  485. Insert(P);
  486. end;
  487. Add:=P;
  488. end;
  489. function IsThereAnyEditor: boolean;
  490. function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
  491. begin
  492. EditorWindow:=(P^.HelpCtx=hcSourceWindow);
  493. end;
  494. begin
  495. IsThereAnyEditor:=Desktop^.FirstThat(@EditorWindow)<>nil;
  496. end;
  497. function IsThereAnyHelpWindow: boolean;
  498. begin
  499. IsThereAnyHelpWindow:=(HelpWindow<>nil) and (HelpWindow^.GetState(sfVisible));
  500. end;
  501. function IsThereAnyNumberedWindow: boolean;
  502. var _Is: boolean;
  503. begin
  504. _Is:=Message(Desktop,evBroadcast,cmSearchWindow,nil)<>nil;
  505. _Is:=_Is or ( (ClipboardWindow<>nil) and ClipboardWindow^.GetState(sfVisible));
  506. IsThereAnyNumberedWindow:=_Is;
  507. end;
  508. function IsWindow(P: PView): boolean;
  509. var OK: boolean;
  510. begin
  511. OK:=false;
  512. if (P^.HelpCtx=hcSourceWindow) or
  513. (P^.HelpCtx=hcHelpWindow) or
  514. (P^.HelpCtx=hcClipboardWindow) or
  515. (P^.HelpCtx=hcCalcWindow) or
  516. (P^.HelpCtx=hcInfoWindow) or
  517. (P^.HelpCtx=hcBrowserWindow) or
  518. (P^.HelpCtx=hcMessagesWindow) or
  519. (P^.HelpCtx=hcGDBWindow) or
  520. (P^.HelpCtx=hcBreakpointListWindow) or
  521. (P^.HelpCtx=hcASCIITableWindow)
  522. then
  523. OK:=true;
  524. IsWindow:=OK;
  525. end;
  526. function IsThereAnyWindow: boolean;
  527. function CheckIt(P: PView): boolean; {$ifndef FPC}far;{$endif}
  528. begin
  529. CheckIt:=IsWindow(P);
  530. end;
  531. begin
  532. IsThereAnyWindow:=Desktop^.FirstThat(@CheckIt)<>nil;
  533. end;
  534. function IsThereAnyVisibleWindow: boolean;
  535. function CheckIt(P: PView): boolean; {$ifndef FPC}far;{$endif}
  536. begin
  537. CheckIt:=IsWindow(P) and P^.GetState(sfVisible);
  538. end;
  539. begin
  540. IsThereAnyVisibleWindow:=Desktop^.FirstThat(@CheckIt)<>nil;
  541. end;
  542. function FirstEditorWindow: PSourceWindow;
  543. function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
  544. begin
  545. EditorWindow:=(P^.HelpCtx=hcSourceWindow);
  546. end;
  547. begin
  548. FirstEditorWindow:=pointer(Desktop^.FirstThat(@EditorWindow));
  549. end;
  550. function EditorWindowFile(const Name : String): PSourceWindow;
  551. function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
  552. begin
  553. EditorWindow:=(TypeOf(P^)=TypeOf(TSourceWindow)) and
  554. {$ifdef Unix}
  555. (PSourceWindow(P)^.Editor^.FileName=Name);
  556. {$else}
  557. (UpcaseStr(PSourceWindow(P)^.Editor^.FileName)=UpcaseStr(Name));
  558. {$endif Unix}
  559. end;
  560. begin
  561. EditorWindowFile:=pointer(Desktop^.FirstThat(@EditorWindow));
  562. end;
  563. function GetEditorCurWord(Editor: PEditor; ValidSpecChars: TCharSet): string;
  564. var S: string;
  565. PS,PE: byte;
  566. function Trim(S: string): string;
  567. const TrimChars : set of char = [#0,#9,' ',#255];
  568. begin
  569. while (length(S)>0) and (S[1] in TrimChars) do Delete(S,1,1);
  570. while (length(S)>0) and (S[length(S)] in TrimChars) do Delete(S,length(S),1);
  571. Trim:=S;
  572. end;
  573. const AlphaNum : set of char = ['A'..'Z','0'..'9','_'];
  574. begin
  575. with Editor^ do
  576. begin
  577. {$ifdef EDITORS}
  578. S:='';
  579. {$else}
  580. S:=GetDisplayText(CurPos.Y);
  581. PS:=CurPos.X; while (PS>0) and (Upcase(S[PS]) in AlphaNum) do Dec(PS);
  582. PE:=CurPos.X; while (PE<length(S)) and (Upcase(S[PE+1]) in (AlphaNum+ValidSpecChars)) do Inc(PE);
  583. S:=Trim(copy(S,PS+1,PE-PS));
  584. {$endif}
  585. end;
  586. GetEditorCurWord:=S;
  587. end;
  588. {*****************************************************************************
  589. Tab
  590. *****************************************************************************}
  591. function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
  592. var P: PTabItem;
  593. begin
  594. New(P); FillChar(P^,SizeOf(P^),0);
  595. P^.Next:=ANext; P^.View:=AView;
  596. NewTabItem:=P;
  597. end;
  598. procedure DisposeTabItem(P: PTabItem);
  599. begin
  600. if P<>nil then
  601. begin
  602. if P^.View<>nil then Dispose(P^.View, Done);
  603. Dispose(P);
  604. end;
  605. end;
  606. function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
  607. var P: PTabDef;
  608. x: byte;
  609. begin
  610. New(P);
  611. P^.Next:=ANext; P^.Name:=NewStr(AName); P^.Items:=AItems;
  612. x:=pos('~',AName);
  613. if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
  614. else P^.ShortCut:=#0;
  615. P^.DefItem:=ADefItem;
  616. NewTabDef:=P;
  617. end;
  618. procedure DisposeTabDef(P: PTabDef);
  619. var PI,X: PTabItem;
  620. begin
  621. DisposeStr(P^.Name);
  622. PI:=P^.Items;
  623. while PI<>nil do
  624. begin
  625. X:=PI^.Next;
  626. DisposeTabItem(PI);
  627. PI:=X;
  628. end;
  629. Dispose(P);
  630. end;
  631. {*****************************************************************************
  632. Reserved Words
  633. *****************************************************************************}
  634. function GetReservedWordCount: integer;
  635. var
  636. Count,I: integer;
  637. begin
  638. Count:=0;
  639. for I:=ord(Low(tToken)) to ord(High(tToken)) do
  640. with TokenInfo^[TToken(I)] do
  641. if (str<>'') and (str[1] in['A'..'Z']) and (keyword=m_all) then
  642. Inc(Count);
  643. GetReservedWordCount:=Count;
  644. end;
  645. function GetReservedWord(Index: integer): string;
  646. var
  647. Count,Idx,I: integer;
  648. S: string;
  649. begin
  650. Idx:=-1;
  651. Count:=-1;
  652. I:=ord(Low(tToken));
  653. while (I<=ord(High(tToken))) and (Idx=-1) do
  654. with TokenInfo^[TToken(I)] do
  655. begin
  656. if (str<>'') and (str[1] in['A'..'Z']) and (keyword=m_all) then
  657. begin
  658. Inc(Count);
  659. if Count=Index then
  660. Idx:=I;
  661. end;
  662. Inc(I);
  663. end;
  664. if Idx=-1 then
  665. S:=''
  666. else
  667. S:=TokenInfo^[TToken(Idx)].str;
  668. GetReservedWord:=S;
  669. end;
  670. procedure InitReservedWords;
  671. var WordS: string;
  672. Idx,I: integer;
  673. begin
  674. InitTokens;
  675. for I:=Low(ReservedWords) to High(ReservedWords) do
  676. New(ReservedWords[I], Init(50,10));
  677. for I:=1 to GetReservedWordCount do
  678. begin
  679. WordS:=GetReservedWord(I-1); Idx:=length(WordS);
  680. ReservedWords[Idx]^.Insert(NewStr(WordS));
  681. end;
  682. end;
  683. procedure DoneReservedWords;
  684. var I: integer;
  685. begin
  686. for I:=Low(ReservedWords) to High(ReservedWords) do
  687. if assigned(ReservedWords[I]) then
  688. begin
  689. dispose(ReservedWords[I],done);
  690. ReservedWords[I]:=nil;
  691. end;
  692. DoneTokens;
  693. end;
  694. function IsFPReservedWord(S: string): boolean;
  695. var _Is: boolean;
  696. Idx,Item: sw_integer;
  697. begin
  698. Idx:=length(S); _Is:=false;
  699. if (Low(ReservedWords)<=Idx) and (Idx<=High(ReservedWords)) and
  700. (ReservedWords[Idx]<>nil) and (ReservedWords[Idx]^.Count<>0) then
  701. begin
  702. S:=UpcaseStr(S);
  703. _Is:=ReservedWords[Idx]^.Search(@S,Item);
  704. end;
  705. IsFPReservedWord:=_Is;
  706. end;
  707. {*****************************************************************************
  708. SearchWindow
  709. *****************************************************************************}
  710. function SearchWindowWithNo(No: integer): PWindow;
  711. var P: PSourceWindow;
  712. begin
  713. P:=Message(Desktop,evBroadcast,cmSearchWindow+No,nil);
  714. if pointer(P)=pointer(Desktop) then P:=nil;
  715. SearchWindowWithNo:=P;
  716. end;
  717. function SearchWindow(const Title: string): PWindow;
  718. function Match(P: PView): boolean; {$ifndef FPC}far;{$endif}
  719. var W: PWindow;
  720. OK: boolean;
  721. begin
  722. W:=nil;
  723. { we have a crash here because of the TStatusLine
  724. that can also have one of these values
  725. but is not a Window object PM }
  726. if P<>pointer(StatusLine) then
  727. if IsWindow(P) then
  728. W:=PWindow(P);
  729. OK:=(W<>nil);
  730. if OK then
  731. begin
  732. OK:=CompareText(W^.GetTitle(255),Title)=0;
  733. end;
  734. Match:=OK;
  735. end;
  736. var W: PView;
  737. begin
  738. W:=Application^.FirstThat(@Match);
  739. { This is wrong because TStatusLine is also considered PM }
  740. if not Assigned(W) then W:=Desktop^.FirstThat(@Match);
  741. { But why do we need to check all ??
  742. Probably because of the ones which were not inserted into
  743. Desktop as the Messages view
  744. Exactly. Some windows are inserted directly in the Application and not
  745. in the Desktop. btw. Does TStatusLine.HelpCtx really change? Why?
  746. Only GetHelpCtx should return different values depending on the
  747. focused view (and it's helpctx), but TStatusLine's HelpCtx field
  748. shouldn't change... Gabor
  749. if Assigned(W)=false then W:=Desktop^.FirstThat(@Match);}
  750. SearchWindow:=PWindow(W);
  751. end;
  752. function SearchFreeWindowNo: integer;
  753. var No: integer;
  754. begin
  755. No:=1;
  756. while (No<100) and (SearchWindowWithNo(No)<>nil) do
  757. Inc(No);
  758. if No=100 then No:=0;
  759. SearchFreeWindowNo:=No;
  760. end;
  761. {*****************************************************************************
  762. TIntegerLine
  763. *****************************************************************************}
  764. constructor TIntegerLine.Init(var Bounds: TRect; AMin, AMax: longint);
  765. begin
  766. if inherited Init(Bounds, Bounds.B.X-Bounds.A.X-1)=false then
  767. Fail;
  768. Validator:=New(PRangeValidator, Init(AMin, AMax));
  769. end;
  770. {*****************************************************************************
  771. SourceEditor
  772. *****************************************************************************}
  773. {$ifndef EDITORS}
  774. function SearchCoreForFileName(const AFileName: string): PCodeEditorCore;
  775. var EC: PCodeEditorCore;
  776. function Check(P: PView): boolean; {$ifndef FPC}far;{$endif}
  777. var OK: boolean;
  778. begin
  779. OK:=P^.HelpCtx=hcSourceWindow;
  780. if OK then
  781. with PSourceWindow(P)^ do
  782. if CompareText(Editor^.FileName,AFileName)=0 then
  783. begin
  784. EC:=Editor^.Core;
  785. end;
  786. Check:=OK;
  787. end;
  788. begin
  789. EC:=nil;
  790. Desktop^.FirstThat(@Check);
  791. SearchCoreForFileName:=EC;
  792. end;
  793. constructor TSourceEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  794. PScrollBar; AIndicator: PIndicator;const AFileName: string);
  795. var EC: PCodeEditorCore;
  796. begin
  797. EC:=SearchCoreForFileName(AFileName);
  798. inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator,EC,AFileName);
  799. SetStoreUndo(true);
  800. CompileStamp:=0;
  801. end;
  802. function TSourceEditor.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
  803. var Count: integer;
  804. begin
  805. case SpecClass of
  806. ssCommentPrefix : Count:=3;
  807. ssCommentSingleLinePrefix : Count:=1;
  808. ssCommentSuffix : Count:=2;
  809. ssStringPrefix : Count:=1;
  810. ssStringSuffix : Count:=1;
  811. ssAsmPrefix : Count:=1;
  812. ssAsmSuffix : Count:=1;
  813. ssDirectivePrefix : Count:=1;
  814. ssDirectiveSuffix : Count:=1;
  815. end;
  816. GetSpecSymbolCount:=Count;
  817. end;
  818. function TSourceEditor.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string;
  819. var S: string[20];
  820. begin
  821. case SpecClass of
  822. ssCommentPrefix :
  823. case Index of
  824. 0 : S:='{';
  825. 1 : S:='(*';
  826. 2 : S:='//';
  827. end;
  828. ssCommentSingleLinePrefix :
  829. case Index of
  830. 0 : S:='//';
  831. end;
  832. ssCommentSuffix :
  833. case Index of
  834. 0 : S:='}';
  835. 1 : S:='*)';
  836. end;
  837. ssStringPrefix :
  838. S:='''';
  839. ssStringSuffix :
  840. S:='''';
  841. ssAsmPrefix :
  842. S:='asm';
  843. ssAsmSuffix :
  844. S:='end';
  845. ssDirectivePrefix :
  846. S:='{$';
  847. ssDirectiveSuffix :
  848. S:='}';
  849. end;
  850. GetSpecSymbol:=S;
  851. end;
  852. function TSourceEditor.IsReservedWord(const S: string): boolean;
  853. begin
  854. IsReservedWord:=IsFPReservedWord(S);
  855. end;
  856. function TSourceEditor.TranslateCodeTemplate(const Shortcut: string; ALines: PUnsortedStringCollection): boolean;
  857. begin
  858. TranslateCodeTemplate:=FPTranslateCodeTemplate(ShortCut,ALines);
  859. end;
  860. function TSourceEditor.CompleteCodeWord(const WordS: string; var Text: string): boolean;
  861. begin
  862. CompleteCodeWord:=FPCompleteCodeWord(WordS,Text);
  863. end;
  864. procedure TSourceEditor.SetCodeCompleteWord(const S: string);
  865. var R: TRect;
  866. begin
  867. inherited SetCodeCompleteWord(S);
  868. if S='' then
  869. begin
  870. if Assigned(CodeCompleteTip) then Dispose(CodeCompleteTip, Done);
  871. CodeCompleteTip:=nil;
  872. end
  873. else
  874. begin
  875. R.Assign(0,0,20,1);
  876. if Assigned(CodeCompleteTip)=false then
  877. begin
  878. New(CodeCompleteTip, Init(R, S, alCenter));
  879. CodeCompleteTip^.Hide;
  880. Application^.Insert(CodeCompleteTip);
  881. end
  882. else
  883. CodeCompleteTip^.SetText(S);
  884. AlignCodeCompleteTip;
  885. end;
  886. end;
  887. procedure TSourceEditor.AlignCodeCompleteTip;
  888. var P: TPoint;
  889. S: string;
  890. R: TRect;
  891. begin
  892. if Assigned(CodeCompleteTip)=false then Exit;
  893. S:=CodeCompleteTip^.GetText;
  894. P.Y:=CurPos.Y;
  895. { determine the center of current word fragment }
  896. P.X:=CurPos.X-(length(GetCodeCompleteFrag) div 2);
  897. { calculate position for centering the complete word over/below the current }
  898. P.X:=P.X-(length(S) div 2);
  899. P.X:=P.X-Delta.X;
  900. P.Y:=P.Y-Delta.Y;
  901. MakeGlobal(P,P);
  902. if Assigned(CodeCompleteTip^.Owner) then
  903. CodeCompleteTip^.Owner^.MakeLocal(P,P);
  904. { ensure that the tooltip stays in screen }
  905. P.X:=Min(Max(0,P.X),ScreenWidth-length(S)-2-1);
  906. { align it vertically }
  907. if P.Y>round(ScreenHeight*3/4) then
  908. Dec(P.Y)
  909. else
  910. Inc(P.Y);
  911. R.Assign(P.X,P.Y,P.X+1+length(S)+1,P.Y+1);
  912. CodeCompleteTip^.Locate(R);
  913. if CodeCompleteTip^.GetState(sfVisible)=false then
  914. CodeCompleteTip^.Show;
  915. end;
  916. {$endif EDITORS}
  917. procedure TSourceEditor.ModifiedChanged;
  918. begin
  919. inherited ModifiedChanged;
  920. if (@Self<>Clipboard) and GetModified then
  921. begin
  922. { global flags }
  923. EditorModified:=true;
  924. { reset compile flags as the file is
  925. not the same as at the compilation anymore }
  926. CompileStamp:=-1;
  927. end;
  928. end;
  929. procedure TSourceEditor.InsertOptions;
  930. var C: PUnsortedStringCollection;
  931. Y: sw_integer;
  932. S: string;
  933. begin
  934. Lock;
  935. New(C, Init(10,10));
  936. GetCompilerOptionLines(C);
  937. if C^.Count>0 then
  938. begin
  939. for Y:=0 to C^.Count-1 do
  940. begin
  941. S:=C^.At(Y)^;
  942. InsertLine(Y,S);
  943. end;
  944. AdjustSelectionPos(0,0,0,C^.Count);
  945. UpdateAttrs(0,attrAll);
  946. DrawLines(0);
  947. SetModified(true);
  948. end;
  949. Dispose(C, Done);
  950. UnLock;
  951. end;
  952. function TSourceEditor.GetLocalMenu: PMenu;
  953. var M: PMenu;
  954. begin
  955. M:=NewMenu(
  956. NewItem(menu_edit_cut,menu_key_edit_cut,kbShiftDel,cmCut,hcCut,
  957. NewItem(menu_edit_copy,menu_key_edit_copy,kbCtrlIns,cmCopy,hcCopy,
  958. NewItem(menu_edit_paste,menu_key_edit_paste,kbShiftIns,cmPaste,hcPaste,
  959. NewItem(menu_edit_clear,menu_key_edit_clear,kbCtrlDel,cmClear,hcClear,
  960. NewLine(
  961. NewItem(menu_srclocal_openfileatcursor,'',kbNoKey,cmOpenAtCursor,hcOpenAtCursor,
  962. NewItem(menu_srclocal_browseatcursor,'',kbNoKey,cmBrowseAtCursor,hcBrowseAtCursor,
  963. NewItem(menu_srclocal_topicsearch,menu_key_help_topicsearch,kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
  964. NewLine(
  965. NewItem(menu_srclocal_options,'',kbNoKey,cmEditorOptions,hcEditorOptions,
  966. nil)))))))))));
  967. GetLocalMenu:=M;
  968. end;
  969. function TSourceEditor.GetCommandTarget: PView;
  970. begin
  971. GetCommandTarget:=@Self;
  972. end;
  973. function TSourceEditor.CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup;
  974. var MV: PAdvancedMenuPopup;
  975. begin
  976. New(MV, Init(Bounds,M));
  977. CreateLocalMenuView:=MV;
  978. end;
  979. {$ifdef DebugUndo}
  980. procedure TSourceEditor.DumpUndo;
  981. var
  982. i : sw_integer;
  983. begin
  984. ClearToolMessages;
  985. AddToolCommand('UndoList Dump');
  986. for i:=0 to Core^.UndoList^.count-1 do
  987. with Core^.UndoList^.At(i)^ do
  988. begin
  989. if is_grouped_action then
  990. AddToolMessage('','Group '+ActionString[action]+' '+IntToStr(ActionCount)+' elementary actions',0,0)
  991. else
  992. AddToolMessage('',ActionString[action]+' '+IntToStr(StartPos.Y+1)+':'+IntToStr(StartPos.X+1)+
  993. ' '+IntToStr(EndPos.Y+1)+':'+IntToStr(EndPos.X+1)+' "'+GetStr(Text)+'"',0,0);
  994. end;
  995. if Core^.RedoList^.count>0 then
  996. AddToolCommand('RedoList Dump');
  997. for i:=0 to Core^.RedoList^.count-1 do
  998. with Core^.RedoList^.At(i)^ do
  999. begin
  1000. if is_grouped_action then
  1001. AddToolMessage('','Group '+ActionString[action]+' '+IntToStr(ActionCount)+' elementary actions',0,0)
  1002. else
  1003. AddToolMessage('',ActionString[action]+' '+IntToStr(StartPos.Y)+':'+IntToStr(StartPos.X+1)+
  1004. ' '+IntToStr(EndPos.Y+1)+':'+IntToStr(EndPos.X+1)+' "'+GetStr(Text)+'"',0,0);
  1005. end;
  1006. UpdateToolMessages;
  1007. if Assigned(MessagesWindow) then
  1008. MessagesWindow^.Focus;
  1009. end;
  1010. procedure TSourceEditor.UndoAll;
  1011. begin
  1012. While Core^.UndoList^.count>0 do
  1013. Undo;
  1014. end;
  1015. procedure TSourceEditor.RedoAll;
  1016. begin
  1017. While Core^.RedoList^.count>0 do
  1018. Redo;
  1019. end;
  1020. {$endif DebugUndo}
  1021. procedure TSourceEditor.HandleEvent(var Event: TEvent);
  1022. var DontClear: boolean;
  1023. S: string;
  1024. begin
  1025. TranslateMouseClick(@Self,Event);
  1026. case Event.What of
  1027. evKeyDown :
  1028. begin
  1029. DontClear:=false;
  1030. case Event.KeyCode of
  1031. kbCtrlEnter :
  1032. Message(@Self,evCommand,cmOpenAtCursor,nil);
  1033. else DontClear:=true;
  1034. end;
  1035. if not DontClear then ClearEvent(Event);
  1036. end;
  1037. end;
  1038. inherited HandleEvent(Event);
  1039. case Event.What of
  1040. evCommand :
  1041. begin
  1042. DontClear:=false;
  1043. case Event.Command of
  1044. {$ifdef DebugUndo}
  1045. cmDumpUndo : DumpUndo;
  1046. cmUndoAll : UndoAll;
  1047. cmRedoAll : RedoAll;
  1048. {$endif DebugUndo}
  1049. cmBrowseAtCursor:
  1050. begin
  1051. S:=LowerCaseStr(GetEditorCurWord(@Self,[]));
  1052. OpenOneSymbolBrowser(S);
  1053. end;
  1054. cmOpenAtCursor :
  1055. begin
  1056. S:=LowerCaseStr(GetEditorCurWord(@Self,['.']));
  1057. if Pos('.',S)<>0 then
  1058. OpenFileName:=S else
  1059. OpenFileName:=S+'.pp'+ListSeparator+
  1060. S+'.pas'+ListSeparator+
  1061. S+'.inc';
  1062. Message(Application,evCommand,cmOpen,nil);
  1063. end;
  1064. cmEditorOptions :
  1065. Message(Application,evCommand,cmEditorOptions,@Self);
  1066. cmHelp :
  1067. Message(@Self,evCommand,cmHelpTopicSearch,@Self);
  1068. cmHelpTopicSearch :
  1069. HelpTopicSearch(@Self);
  1070. else DontClear:=true;
  1071. end;
  1072. if not DontClear then ClearEvent(Event);
  1073. end;
  1074. end;
  1075. end;
  1076. constructor TFPHeapView.Init(var Bounds: TRect);
  1077. begin
  1078. if inherited Init(Bounds)=false then Fail;
  1079. Options:=Options or gfGrowHiX or gfGrowHiY;
  1080. EventMask:=EventMask or evIdle;
  1081. GrowMode:=gfGrowAll;
  1082. end;
  1083. constructor TFPHeapView.InitKb(var Bounds: TRect);
  1084. begin
  1085. if inherited InitKb(Bounds)=false then Fail;
  1086. Options:=Options or gfGrowHiX or gfGrowHiY;
  1087. EventMask:=EventMask or evIdle;
  1088. GrowMode:=gfGrowAll;
  1089. end;
  1090. procedure TFPHeapView.HandleEvent(var Event: TEvent);
  1091. begin
  1092. case Event.What of
  1093. evIdle :
  1094. Update;
  1095. end;
  1096. inherited HandleEvent(Event);
  1097. end;
  1098. constructor TFPClockView.Init(var Bounds: TRect);
  1099. begin
  1100. inherited Init(Bounds);
  1101. EventMask:=EventMask or evIdle;
  1102. end;
  1103. procedure TFPClockView.HandleEvent(var Event: TEvent);
  1104. begin
  1105. case Event.What of
  1106. evIdle :
  1107. Update;
  1108. end;
  1109. inherited HandleEvent(Event);
  1110. end;
  1111. function TFPClockView.GetPalette: PPalette;
  1112. const P: string[length(CFPClockView)] = CFPClockView;
  1113. begin
  1114. GetPalette:=@P;
  1115. end;
  1116. procedure TFPWindow.SetState(AState: Word; Enable: Boolean);
  1117. begin
  1118. inherited SetState(AState,Enable);
  1119. if AutoNumber then
  1120. if (AState and (sfVisible+sfExposed))<>0 then
  1121. if GetState(sfVisible+sfExposed) then
  1122. begin
  1123. if Number=0 then
  1124. Number:=SearchFreeWindowNo;
  1125. ReDraw;
  1126. end
  1127. else
  1128. Number:=0;
  1129. end;
  1130. procedure TFPWindow.Update;
  1131. begin
  1132. ReDraw;
  1133. end;
  1134. procedure TFPWindow.HandleEvent(var Event: TEvent);
  1135. begin
  1136. case Event.What of
  1137. evBroadcast :
  1138. case Event.Command of
  1139. cmUpdate :
  1140. Update;
  1141. cmSearchWindow+1..cmSearchWindow+99 :
  1142. if (Event.Command-cmSearchWindow=Number) then
  1143. ClearEvent(Event);
  1144. end;
  1145. end;
  1146. inherited HandleEvent(Event);
  1147. end;
  1148. constructor TFPWindow.Load(var S: TStream);
  1149. begin
  1150. inherited Load(S);
  1151. S.Read(AutoNumber,SizeOf(AutoNumber));
  1152. end;
  1153. procedure TFPWindow.Store(var S: TStream);
  1154. begin
  1155. inherited Store(S);
  1156. S.Write(AutoNumber,SizeOf(AutoNumber));
  1157. end;
  1158. function TFPHelpViewer.GetLocalMenu: PMenu;
  1159. var M: PMenu;
  1160. begin
  1161. M:=NewMenu(
  1162. NewItem(menu_hlplocal_contents,'',kbNoKey,cmHelpContents,hcHelpContents,
  1163. NewItem(menu_hlplocal_index,menu_key_hlplocal_index,kbShiftF1,cmHelpIndex,hcHelpIndex,
  1164. NewItem(menu_hlplocal_topicsearch,menu_key_hlplocal_topicsearch,kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
  1165. NewItem(menu_hlplocal_prevtopic,menu_key_hlplocal_prevtopic,kbAltF1,cmHelpPrevTopic,hcHelpPrevTopic,
  1166. NewLine(
  1167. NewItem(menu_hlplocal_copy,menu_key_hlplocal_copy,kbCtrlIns,cmCopy,hcCopy,
  1168. nil)))))));
  1169. GetLocalMenu:=M;
  1170. end;
  1171. function TFPHelpViewer.GetCommandTarget: PView;
  1172. begin
  1173. GetCommandTarget:=Application;
  1174. end;
  1175. constructor TFPHelpWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word;
  1176. AContext: THelpCtx; ANumber: Integer);
  1177. begin
  1178. inherited Init(Bounds,ATitle,ASourceFileID,AContext,ANumber);
  1179. HelpCtx:=hcHelpWindow;
  1180. HideOnClose:=true;
  1181. end;
  1182. destructor TFPHelpWindow.Done;
  1183. begin
  1184. if HelpWindow=@Self then
  1185. HelpWindow:=nil;
  1186. Inherited Done;
  1187. end;
  1188. procedure TFPHelpWindow.InitHelpView;
  1189. var R: TRect;
  1190. begin
  1191. GetExtent(R); R.Grow(-1,-1);
  1192. HelpView:=New(PFPHelpViewer, Init(R, HSB, VSB));
  1193. HelpView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1194. end;
  1195. procedure TFPHelpWindow.Show;
  1196. begin
  1197. inherited Show;
  1198. if GetState(sfVisible) and (Number=0) then
  1199. begin
  1200. Number:=SearchFreeWindowNo;
  1201. ReDraw;
  1202. end;
  1203. end;
  1204. procedure TFPHelpWindow.Hide;
  1205. begin
  1206. inherited Hide;
  1207. if GetState(sfVisible)=false then
  1208. Number:=0;
  1209. end;
  1210. procedure TFPHelpWindow.HandleEvent(var Event: TEvent);
  1211. begin
  1212. case Event.What of
  1213. evBroadcast :
  1214. case Event.Command of
  1215. cmUpdate :
  1216. ReDraw;
  1217. cmSearchWindow+1..cmSearchWindow+99 :
  1218. if (Event.Command-cmSearchWindow=Number) then
  1219. ClearEvent(Event);
  1220. end;
  1221. end;
  1222. inherited HandleEvent(Event);
  1223. end;
  1224. function TFPHelpWindow.GetPalette: PPalette;
  1225. const P: string[length(CIDEHelpDialog)] = CIDEHelpDialog;
  1226. begin
  1227. GetPalette:=@P;
  1228. end;
  1229. constructor TFPHelpWindow.Load(var S: TStream);
  1230. begin
  1231. Abstract;
  1232. end;
  1233. procedure TFPHelpWindow.Store(var S: TStream);
  1234. begin
  1235. Abstract;
  1236. end;
  1237. constructor TSourceWindow.Init(var Bounds: TRect; AFileName: string);
  1238. var HSB,VSB: PScrollBar;
  1239. R: TRect;
  1240. PA : Array[1..2] of pointer;
  1241. LoadFile: boolean;
  1242. begin
  1243. inherited Init(Bounds,AFileName,{SearchFreeWindowNo}0);
  1244. AutoNumber:=true;
  1245. Options:=Options or ofTileAble;
  1246. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
  1247. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  1248. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  1249. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  1250. GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
  1251. New(Indicator, Init(R));
  1252. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  1253. Insert(Indicator);
  1254. GetExtent(R); R.Grow(-1,-1);
  1255. LoadFile:=AFileName<>'';
  1256. if not LoadFile then
  1257. begin SetTitle('noname'+IntToStrZ(NonameCount,2)+'.pas'); Inc(NonameCount); end;
  1258. New(Editor, Init(R, HSB, VSB, Indicator,AFileName));
  1259. Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1260. if LoadFile then
  1261. begin
  1262. if Editor^.LoadFile=false then
  1263. ErrorBox(FormatStrStr(msg_errorreadingfile,AFileName),nil)
  1264. else if Editor^.GetModified then
  1265. begin
  1266. PA[1]:=@AFileName;
  1267. longint(PA[2]):={Editor^.ChangedLine}-1;
  1268. EditorDialog(edChangedOnloading,@PA);
  1269. end;
  1270. end;
  1271. Insert(Editor);
  1272. If assigned(BreakpointsCollection) then
  1273. BreakpointsCollection^.ShowBreakpoints(@Self);
  1274. UpdateTitle;
  1275. end;
  1276. procedure TSourceWindow.UpdateTitle;
  1277. var Name: string;
  1278. Count: sw_integer;
  1279. begin
  1280. if Editor^.FileName<>'' then
  1281. begin
  1282. Name:=SmartPath(Editor^.FileName);
  1283. Count:=Editor^.Core^.GetBindingCount;
  1284. if Count>1 then
  1285. begin
  1286. Name:=Name+':'+IntToStr(Editor^.Core^.GetBindingIndex(Editor)+1);
  1287. end;
  1288. SetTitle(Name);
  1289. end;
  1290. end;
  1291. function TSourceWindow.GetTitle(MaxSize: sw_Integer): TTitleStr;
  1292. begin
  1293. GetTitle:=OptimizePath(inherited GetTitle(255),MaxSize);
  1294. end;
  1295. procedure TSourceWindow.SetTitle(ATitle: string);
  1296. begin
  1297. if Title<>nil then DisposeStr(Title);
  1298. Title:=NewStr(ATitle);
  1299. Frame^.DrawView;
  1300. end;
  1301. procedure TSourceWindow.HandleEvent(var Event: TEvent);
  1302. var DontClear: boolean;
  1303. begin
  1304. case Event.What of
  1305. evBroadcast :
  1306. case Event.Command of
  1307. cmUpdate :
  1308. Update;
  1309. cmUpdateTitle :
  1310. UpdateTitle;
  1311. cmSearchWindow :
  1312. if @Self<>ClipboardWindow then
  1313. ClearEvent(Event);
  1314. end;
  1315. evCommand :
  1316. begin
  1317. DontClear:=false;
  1318. case Event.Command of
  1319. cmHide :
  1320. Hide;
  1321. cmSave :
  1322. if Editor^.IsClipboard=false then
  1323. if (Editor^.FileName='') and Editor^.GetModified then
  1324. Editor^.SaveAs
  1325. else
  1326. Editor^.Save;
  1327. cmSaveAs :
  1328. if Editor^.IsClipboard=false then
  1329. Editor^.SaveAs;
  1330. else DontClear:=true;
  1331. end;
  1332. if DontClear=false then ClearEvent(Event);
  1333. end;
  1334. end;
  1335. inherited HandleEvent(Event);
  1336. end;
  1337. procedure TSourceWindow.SetState(AState: Word; Enable: Boolean);
  1338. var OldState: word;
  1339. begin
  1340. OldState:=State;
  1341. inherited SetState(AState,Enable);
  1342. if ((AState and sfActive)<>0) and (((OldState xor State) and sfActive)<>0) then
  1343. UpdateCommands;
  1344. end;
  1345. procedure TSourceWindow.UpdateCommands;
  1346. var Active: boolean;
  1347. begin
  1348. Active:=GetState(sfActive);
  1349. if Editor^.IsClipboard=false then
  1350. begin
  1351. SetCmdState(SourceCmds+CompileCmds,Active);
  1352. SetCmdState(EditorCmds,Active);
  1353. end;
  1354. SetCmdState(ToClipCmds+FromClipCmds+NulClipCmds+UndoCmd+RedoCmd,Active);
  1355. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  1356. end;
  1357. procedure TSourceWindow.Update;
  1358. begin
  1359. ReDraw;
  1360. end;
  1361. procedure TSourceWindow.SelectInDebugSession;
  1362. var
  1363. F,PrevCurrent : PView;
  1364. begin
  1365. DeskTop^.Lock;
  1366. PrevCurrent:=Desktop^.Current;
  1367. F:=PrevCurrent;
  1368. While assigned(F) and
  1369. ((F^.HelpCtx = hcGDBWindow) or
  1370. (F^.HelpCtx = hcWatches) or {hcStack,}
  1371. (F^.HelpCtx = hcRegisters)) do
  1372. F:=F^.NextView;
  1373. if F<>@Self then
  1374. Select;
  1375. if PrevCurrent<>F then
  1376. Begin
  1377. Desktop^.InsertBefore(@self,F);
  1378. PrevCurrent^.Select;
  1379. End;
  1380. DeskTop^.Unlock;
  1381. end;
  1382. function TSourceWindow.GetPalette: PPalette;
  1383. const P: string[length(CSourceWindow)] = CSourceWindow;
  1384. begin
  1385. GetPalette:=@P;
  1386. end;
  1387. constructor TSourceWindow.Load(var S: TStream);
  1388. begin
  1389. Title:=S.ReadStr;
  1390. PushStatus(FormatStrStr(msg_loadingfile,GetStr(Title)));
  1391. inherited Load(S);
  1392. GetSubViewPtr(S,Indicator);
  1393. GetSubViewPtr(S,Editor);
  1394. If assigned(BreakpointsCollection) then
  1395. BreakpointsCollection^.ShowBreakpoints(@Self);
  1396. PopStatus;
  1397. end;
  1398. procedure TSourceWindow.Store(var S: TStream);
  1399. begin
  1400. S.WriteStr(Title);
  1401. PushStatus(FormatStrStr(msg_storingfile,GetStr(Title)));
  1402. inherited Store(S);
  1403. PutSubViewPtr(S,Indicator);
  1404. PutSubViewPtr(S,Editor);
  1405. PopStatus;
  1406. end;
  1407. procedure TSourceWindow.Close;
  1408. begin
  1409. inherited Close;
  1410. end;
  1411. destructor TSourceWindow.Done;
  1412. begin
  1413. PushStatus(FormatStrStr(msg_closingfile,GetStr(Title)));
  1414. if not IDEApp.IsClosing then
  1415. Message(Application,evBroadcast,cmSourceWndClosing,@Self);
  1416. inherited Done;
  1417. IDEApp.SourceWindowClosed;
  1418. { if not IDEApp.IsClosing then
  1419. Message(Application,evBroadcast,cmUpdate,@Self);}
  1420. PopStatus;
  1421. end;
  1422. function TGDBSourceEditor.Valid(Command: Word): Boolean;
  1423. var OK: boolean;
  1424. begin
  1425. OK:=TCodeEditor.Valid(Command);
  1426. { do NOT ask for save !!
  1427. if OK and ((Command=cmClose) or (Command=cmQuit)) then
  1428. if IsClipboard=false then
  1429. OK:=SaveAsk; }
  1430. Valid:=OK;
  1431. end;
  1432. procedure TGDBSourceEditor.AddLine(const S: string);
  1433. begin
  1434. if Silent or (IgnoreStringAtEnd and (S=LastCommand)) then exit;
  1435. inherited AddLine(S);
  1436. LimitsChanged;
  1437. end;
  1438. procedure TGDBSourceEditor.AddErrorLine(const S: string);
  1439. begin
  1440. if Silent then exit;
  1441. inherited AddLine(S);
  1442. { display like breakpoints in red }
  1443. SetLineFlagState(GetLineCount-1,lfBreakpoint,true);
  1444. LimitsChanged;
  1445. end;
  1446. const
  1447. GDBReservedCount = 6;
  1448. GDBReservedLongest = 3;
  1449. GDBReserved : array[1..GDBReservedCount] of String[GDBReservedLongest] =
  1450. ('gdb','b','n','s','f','bt');
  1451. function IsGDBReservedWord(const S : string) : boolean;
  1452. var
  1453. i : longint;
  1454. begin
  1455. for i:=1 to GDBReservedCount do
  1456. if (S=GDBReserved[i]) then
  1457. begin
  1458. IsGDBReservedWord:=true;
  1459. exit;
  1460. end;
  1461. IsGDBReservedWord:=false;
  1462. end;
  1463. function TGDBSourceEditor.IsReservedWord(const S: string): boolean;
  1464. begin
  1465. IsReservedWord:=IsGDBReservedWord(S);
  1466. end;
  1467. function TGDBSourceEditor.InsertNewLine: Sw_integer;
  1468. Var
  1469. S : string;
  1470. CommandCalled : boolean;
  1471. begin
  1472. if IsReadOnly then begin InsertNewLine:=-1; Exit; end;
  1473. if CurPos.Y<GetLineCount then S:=GetDisplayText(CurPos.Y) else S:='';
  1474. s:=Copy(S,1,CurPos.X);
  1475. CommandCalled:=false;
  1476. if Pos(GDBPrompt,S)=1 then
  1477. Delete(S,1,length(GDBPrompt));
  1478. if assigned(Debugger) then
  1479. if S<>'' then
  1480. begin
  1481. LastCommand:=S;
  1482. { should be true only if we are at the end ! }
  1483. IgnoreStringAtEnd:=(CurPos.Y=GetLineCount-1) and
  1484. (CurPos.X>=length(RTrim(GetDisplayText(GetLineCount-1))));
  1485. Debugger^.Command(S);
  1486. CommandCalled:=true;
  1487. IgnoreStringAtEnd:=false;
  1488. end
  1489. else if AutoRepeat and (CurPos.Y=GetLineCount-1) then
  1490. begin
  1491. Debugger^.Command(LastCommand);
  1492. CommandCalled:=true;
  1493. end;
  1494. InsertNewLine:=inherited InsertNewLine;
  1495. If CommandCalled then
  1496. InsertText(GDBPrompt);
  1497. end;
  1498. constructor TGDBWindow.Init(var Bounds: TRect);
  1499. var HSB,VSB: PScrollBar;
  1500. R: TRect;
  1501. begin
  1502. inherited Init(Bounds,dialog_gdbwindow,0);
  1503. Options:=Options or ofTileAble;
  1504. AutoNumber:=true;
  1505. HelpCtx:=hcGDBWindow;
  1506. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
  1507. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  1508. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  1509. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  1510. GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
  1511. New(Indicator, Init(R));
  1512. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  1513. Insert(Indicator);
  1514. GetExtent(R); R.Grow(-1,-1);
  1515. New(Editor, Init(R, HSB, VSB, nil, GDBOutputFile));
  1516. Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1517. Editor^.SetFlags(efInsertMode+efSyntaxHighlight+efNoIndent+efExpandAllTabs);
  1518. if ExistsFile(GDBOutputFile) then
  1519. begin
  1520. if Editor^.LoadFile=false then
  1521. ErrorBox(FormatStrStr(msg_errorreadingfile,GDBOutputFile),nil);
  1522. end
  1523. else
  1524. { Empty files are buggy !! }
  1525. Editor^.AddLine('');
  1526. Insert(Editor);
  1527. if assigned(Debugger) then
  1528. Debugger^.Command('set width '+IntToStr(Size.X-1));
  1529. Editor^.silent:=false;
  1530. Editor^.AutoRepeat:=true;
  1531. end;
  1532. destructor TGDBWindow.Done;
  1533. begin
  1534. if @Self=GDBWindow then
  1535. GDBWindow:=nil;
  1536. inherited Done;
  1537. end;
  1538. constructor TGDBWindow.Load(var S: TStream);
  1539. begin
  1540. inherited Load(S);
  1541. GetSubViewPtr(S,Indicator);
  1542. GetSubViewPtr(S,Editor);
  1543. end;
  1544. procedure TGDBWindow.Store(var S: TStream);
  1545. begin
  1546. inherited Store(S);
  1547. PutSubViewPtr(S,Indicator);
  1548. PutSubViewPtr(S,Editor);
  1549. end;
  1550. function TGDBWindow.GetPalette: PPalette;
  1551. const P: string[length(CSourceWindow)] = CSourceWindow;
  1552. begin
  1553. GetPalette:=@P;
  1554. end;
  1555. procedure TGDBWindow.WriteOutputText(Buf : pchar);
  1556. begin
  1557. {selected normal color ?}
  1558. WriteText(Buf,false);
  1559. end;
  1560. procedure TGDBWindow.WriteErrorText(Buf : pchar);
  1561. begin
  1562. {selected normal color ?}
  1563. WriteText(Buf,true);
  1564. end;
  1565. procedure TGDBWindow.WriteString(Const S : string);
  1566. begin
  1567. Editor^.AddLine(S);
  1568. end;
  1569. procedure TGDBWindow.WriteErrorString(Const S : string);
  1570. begin
  1571. Editor^.AddErrorLine(S);
  1572. end;
  1573. procedure TGDBWindow.WriteText(Buf : pchar;IsError : boolean);
  1574. var p,pe : pchar;
  1575. s : string;
  1576. begin
  1577. p:=buf;
  1578. DeskTop^.Lock;
  1579. While assigned(p) and (p^<>#0) do
  1580. begin
  1581. pe:=strscan(p,#10);
  1582. if pe<>nil then
  1583. pe^:=#0;
  1584. s:=strpas(p);
  1585. If IsError then
  1586. Editor^.AddErrorLine(S)
  1587. else
  1588. Editor^.AddLine(S);
  1589. { restore for dispose }
  1590. if pe<>nil then
  1591. pe^:=#10;
  1592. if pe=nil then
  1593. p:=nil
  1594. else
  1595. begin
  1596. if pe-p > High(s) then
  1597. p:=p+High(s)-1
  1598. else
  1599. begin
  1600. p:=pe;
  1601. inc(p);
  1602. end;
  1603. end;
  1604. end;
  1605. DeskTop^.Unlock;
  1606. Editor^.Draw;
  1607. end;
  1608. procedure TGDBWindow.SetState(AState: Word; Enable: Boolean);
  1609. var OldState: word;
  1610. begin
  1611. OldState:=State;
  1612. inherited SetState(AState,Enable);
  1613. if ((AState and sfActive)<>0) and (((OldState xor State) and sfActive)<>0) then
  1614. UpdateCommands;
  1615. end;
  1616. procedure TGDBWindow.UpdateCommands;
  1617. var Active: boolean;
  1618. begin
  1619. Active:=GetState(sfActive);
  1620. SetCmdState([cmSaveAs,cmHide],Active);
  1621. SetCmdState(EditorCmds,Active);
  1622. SetCmdState(ToClipCmds+FromClipCmds+NulClipCmds+UndoCmd+RedoCmd,Active);
  1623. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  1624. end;
  1625. constructor TClipboardWindow.Init;
  1626. var R: TRect;
  1627. HSB,VSB: PScrollBar;
  1628. begin
  1629. Desktop^.GetExtent(R);
  1630. inherited Init(R, '');
  1631. SetTitle(dialog_clipboard);
  1632. HelpCtx:=hcClipboardWindow;
  1633. Number:=wnNoNumber;
  1634. AutoNumber:=true;
  1635. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
  1636. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  1637. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  1638. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  1639. GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
  1640. New(Indicator, Init(R));
  1641. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  1642. Insert(Indicator);
  1643. GetExtent(R); R.Grow(-1,-1);
  1644. New(Editor, Init(R, HSB, VSB, Indicator, ''));
  1645. Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1646. Insert(Editor);
  1647. Hide;
  1648. Clipboard:=Editor;
  1649. end;
  1650. procedure TClipboardWindow.Close;
  1651. begin
  1652. Hide;
  1653. end;
  1654. constructor TClipboardWindow.Load(var S: TStream);
  1655. begin
  1656. inherited Load(S);
  1657. Clipboard:=Editor;
  1658. end;
  1659. procedure TClipboardWindow.Store(var S: TStream);
  1660. begin
  1661. inherited Store(S);
  1662. end;
  1663. destructor TClipboardWindow.Done;
  1664. begin
  1665. inherited Done;
  1666. Clipboard:=nil;
  1667. ClipboardWindow:=nil;
  1668. end;
  1669. constructor TMessageListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1670. begin
  1671. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  1672. GrowMode:=gfGrowHiX+gfGrowHiY;
  1673. New(ModuleNames, Init(50,100));
  1674. NoSelection:=true;
  1675. end;
  1676. function TMessageListBox.GetLocalMenu: PMenu;
  1677. var M: PMenu;
  1678. begin
  1679. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  1680. M:=NewMenu(
  1681. NewItem(menu_msglocal_clear,'',kbNoKey,cmMsgClear,hcMsgClear,
  1682. NewLine(
  1683. NewItem(menu_msglocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  1684. NewItem(menu_msglocal_tracksource,'',kbNoKey,cmMsgTrackSource,hcMsgTrackSource,
  1685. nil)))));
  1686. GetLocalMenu:=M;
  1687. end;
  1688. procedure TMessageListBox.HandleEvent(var Event: TEvent);
  1689. var DontClear: boolean;
  1690. begin
  1691. case Event.What of
  1692. evKeyDown :
  1693. begin
  1694. DontClear:=false;
  1695. case Event.KeyCode of
  1696. kbEnter :
  1697. Message(@Self,evCommand,cmMsgGotoSource,nil);
  1698. else
  1699. DontClear:=true;
  1700. end;
  1701. if not DontClear then
  1702. ClearEvent(Event);
  1703. end;
  1704. evBroadcast :
  1705. case Event.Command of
  1706. cmListItemSelected :
  1707. if Event.InfoPtr=@Self then
  1708. Message(@Self,evCommand,cmMsgTrackSource,nil);
  1709. end;
  1710. evCommand :
  1711. begin
  1712. DontClear:=false;
  1713. case Event.Command of
  1714. cmMsgGotoSource :
  1715. if Range>0 then
  1716. GotoSource;
  1717. cmMsgTrackSource :
  1718. if Range>0 then
  1719. TrackSource;
  1720. cmMsgClear :
  1721. Clear;
  1722. else
  1723. DontClear:=true;
  1724. end;
  1725. if not DontClear then
  1726. ClearEvent(Event);
  1727. end;
  1728. end;
  1729. inherited HandleEvent(Event);
  1730. end;
  1731. procedure TMessageListBox.AddItem(P: PMessageItem);
  1732. var W : integer;
  1733. begin
  1734. if List=nil then New(List, Init(500,500));
  1735. W:=length(P^.GetText(255));
  1736. if W>MaxWidth then
  1737. begin
  1738. MaxWidth:=W;
  1739. if HScrollBar<>nil then
  1740. HScrollBar^.SetRange(0,MaxWidth);
  1741. end;
  1742. List^.Insert(P);
  1743. SetRange(List^.Count);
  1744. if Focused=List^.Count-1-1 then
  1745. FocusItem(List^.Count-1);
  1746. DrawView;
  1747. end;
  1748. function TMessageListBox.AddModuleName(const Name: string): PString;
  1749. var P: PString;
  1750. begin
  1751. if ModuleNames<>nil then
  1752. P:=ModuleNames^.Add(Name)
  1753. else
  1754. P:=nil;
  1755. AddModuleName:=P;
  1756. end;
  1757. function TMessageListBox.GetText(Item,MaxLen: Sw_Integer): String;
  1758. var P: PMessageItem;
  1759. S: string;
  1760. begin
  1761. P:=List^.At(Item);
  1762. S:=P^.GetText(MaxLen);
  1763. GetText:=copy(S,1,MaxLen);
  1764. end;
  1765. procedure TMessageListBox.Clear;
  1766. begin
  1767. if assigned(List) then
  1768. Dispose(List, Done);
  1769. List:=nil;
  1770. MaxWidth:=0;
  1771. if assigned(ModuleNames) then
  1772. ModuleNames^.FreeAll;
  1773. SetRange(0); DrawView;
  1774. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1775. end;
  1776. procedure TMessageListBox.TrackSource;
  1777. var W: PSourceWindow;
  1778. P: PMessageItem;
  1779. R: TRect;
  1780. Row,Col: sw_integer;
  1781. begin
  1782. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1783. if Range=0 then Exit;
  1784. P:=List^.At(Focused);
  1785. if P^.Row=0 then Exit;
  1786. Desktop^.Lock;
  1787. GetNextEditorBounds(R);
  1788. {$ifdef OLDCOMP}
  1789. if Assigned(Owner) and (Owner=pointer(ProgramInfoWindow)) then
  1790. {$endif}
  1791. R.B.Y:=Owner^.Origin.Y;
  1792. if P^.Row>0 then Row:=P^.Row-1 else Row:=0;
  1793. if P^.Col>0 then Col:=P^.Col-1 else Col:=0;
  1794. W:=EditorWindowFile(P^.GetModuleName);
  1795. if assigned(W) then
  1796. begin
  1797. W^.GetExtent(R);
  1798. {$ifdef OLDCOMP}
  1799. if Assigned(Owner) and (Owner=pointer(ProgramInfoWindow)) then
  1800. {$endif}
  1801. R.B.Y:=Owner^.Origin.Y;
  1802. W^.ChangeBounds(R);
  1803. W^.Editor^.SetCurPtr(Col,Row);
  1804. end
  1805. else
  1806. W:=TryToOpenFile(@R,P^.GetModuleName,Col,Row,true);
  1807. if W<>nil then
  1808. begin
  1809. W^.Select;
  1810. W^.Editor^.TrackCursor(true);
  1811. W^.Editor^.SetLineFlagExclusive(lfHighlightRow,Row);
  1812. end;
  1813. if Assigned(Owner) then
  1814. Owner^.Select;
  1815. Desktop^.UnLock;
  1816. end;
  1817. procedure TMessageListBox.GotoSource;
  1818. var W: PSourceWindow;
  1819. P: PMessageItem;
  1820. R:TRect;
  1821. Row,Col: sw_integer;
  1822. begin
  1823. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1824. if Range=0 then Exit;
  1825. P:=List^.At(Focused);
  1826. if P^.Row=0 then Exit;
  1827. Desktop^.Lock;
  1828. if P^.Row>0 then Row:=P^.Row-1 else Row:=0;
  1829. if P^.Col>0 then Col:=P^.Col-1 else Col:=0;
  1830. W:=TryToOpenFile(nil,P^.GetModuleName,Col,Row,true);
  1831. if assigned(W) then
  1832. begin
  1833. { Message(Owner,evCommand,cmClose,nil);
  1834. This calls close on StackWindow
  1835. rendering P invalid
  1836. so postpone it PM }
  1837. W^.GetExtent(R);
  1838. if (P^.TClass<>0) then
  1839. W^.Editor^.SetErrorMessage(P^.GetText(R.B.X-R.A.X));
  1840. W^.Select;
  1841. Message(Owner,evCommand,cmClose,nil);
  1842. end;
  1843. Desktop^.UnLock;
  1844. end;
  1845. procedure TMessageListBox.Draw;
  1846. var
  1847. I, J, Item: Sw_Integer;
  1848. NormalColor, SelectedColor, FocusedColor, Color: Word;
  1849. ColWidth, CurCol, Indent: Integer;
  1850. B: TDrawBuffer;
  1851. Text: String;
  1852. SCOff: Byte;
  1853. TC: byte;
  1854. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  1855. begin
  1856. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  1857. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  1858. begin
  1859. NormalColor := GetColor(1);
  1860. FocusedColor := GetColor(3);
  1861. SelectedColor := GetColor(4);
  1862. end else
  1863. begin
  1864. NormalColor := GetColor(2);
  1865. SelectedColor := GetColor(4);
  1866. end;
  1867. if Transparent then
  1868. begin MT(NormalColor); MT(SelectedColor); end;
  1869. if NoSelection then
  1870. SelectedColor:=NormalColor;
  1871. if HScrollBar <> nil then Indent := HScrollBar^.Value
  1872. else Indent := 0;
  1873. ColWidth := Size.X div NumCols + 1;
  1874. for I := 0 to Size.Y - 1 do
  1875. begin
  1876. for J := 0 to NumCols-1 do
  1877. begin
  1878. Item := J*Size.Y + I + TopItem;
  1879. CurCol := J*ColWidth;
  1880. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  1881. (Focused = Item) and (Range > 0) then
  1882. begin
  1883. Color := FocusedColor;
  1884. SetCursor(CurCol+1,I);
  1885. SCOff := 0;
  1886. end
  1887. else if (Item < Range) and IsSelected(Item) then
  1888. begin
  1889. Color := SelectedColor;
  1890. SCOff := 2;
  1891. end
  1892. else
  1893. begin
  1894. Color := NormalColor;
  1895. SCOff := 4;
  1896. end;
  1897. MoveChar(B[CurCol], ' ', Color, ColWidth);
  1898. if Item < Range then
  1899. begin
  1900. Text := GetText(Item, ColWidth + Indent);
  1901. Text := Copy(Text,Indent,ColWidth);
  1902. MoveStr(B[CurCol+1], Text, Color);
  1903. if ShowMarkers then
  1904. begin
  1905. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  1906. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  1907. end;
  1908. end;
  1909. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  1910. end;
  1911. WriteLine(0, I, Size.X, 1, B);
  1912. end;
  1913. end;
  1914. constructor TMessageListBox.Load(var S: TStream);
  1915. begin
  1916. inherited Load(S);
  1917. New(ModuleNames, Init(50,100));
  1918. NoSelection:=true;
  1919. end;
  1920. procedure TMessageListBox.Store(var S: TStream);
  1921. var OL: PCollection;
  1922. ORV: sw_integer;
  1923. begin
  1924. OL:=List; ORV:=Range;
  1925. New(List, Init(1,1)); Range:=0;
  1926. inherited Store(S);
  1927. Dispose(List, Done);
  1928. List:=OL; Range:=ORV;
  1929. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  1930. collection? Pasting here a modified version of TListBox.Store+
  1931. TAdvancedListBox.Store isn't a better solution, since by eventually
  1932. changing the obj-hierarchy you'll always have to modify this, too - BG }
  1933. end;
  1934. destructor TMessageListBox.Done;
  1935. begin
  1936. inherited Done;
  1937. if List<>nil then Dispose(List, Done);
  1938. if ModuleNames<>nil then Dispose(ModuleNames, Done);
  1939. end;
  1940. constructor TMessageItem.Init(AClass: longint; const AText: string; AModule: PString; ARow, ACol: sw_integer);
  1941. begin
  1942. inherited Init;
  1943. TClass:=AClass;
  1944. Text:=NewStr(AText);
  1945. Module:=AModule;
  1946. Row:=ARow; Col:=ACol;
  1947. end;
  1948. function TMessageItem.GetText(MaxLen: Sw_integer): string;
  1949. var S: string;
  1950. begin
  1951. if Text=nil then S:='' else S:=Text^;
  1952. if (Module<>nil) then
  1953. S:=NameAndExtOf(Module^)+'('+IntToStr(Row)+') '+S;
  1954. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  1955. GetText:=S;
  1956. end;
  1957. procedure TMessageItem.Selected;
  1958. begin
  1959. end;
  1960. function TMessageItem.GetModuleName: string;
  1961. begin
  1962. GetModuleName:=GetStr(Module);
  1963. end;
  1964. destructor TMessageItem.Done;
  1965. begin
  1966. inherited Done;
  1967. if Text<>nil then DisposeStr(Text);
  1968. { if Module<>nil then DisposeStr(Module);}
  1969. end;
  1970. {$ifdef OLDCOMP}
  1971. function TCompilerMessage.GetText(MaxLen: Integer): String;
  1972. var ClassS: string[20];
  1973. S: string;
  1974. begin
  1975. if TClass=
  1976. V_Fatal then ClassS:='Fatal' else if TClass =
  1977. V_Error then ClassS:='Error' else if TClass =
  1978. V_Normal then ClassS:='' else if TClass =
  1979. V_Warning then ClassS:='Warning' else if TClass =
  1980. V_Note then ClassS:='Note' else if TClass =
  1981. V_Hint then ClassS:='Hint' else if TClass =
  1982. V_Macro then ClassS:='Macro' else if TClass =
  1983. V_Procedure then ClassS:='Procedure' else if TClass =
  1984. V_Conditional then ClassS:='Conditional' else if TClass =
  1985. V_Info then ClassS:='Info' else if TClass =
  1986. V_Status then ClassS:='Status' else if TClass =
  1987. V_Used then ClassS:='Used' else if TClass =
  1988. V_Tried then ClassS:='Tried' else if TClass =
  1989. V_Debug then ClassS:='Debug'
  1990. else
  1991. ClassS:='???';
  1992. if ClassS<>'' then
  1993. ClassS:=RExpand(ClassS,0)+': ';
  1994. S:=ClassS;
  1995. if (Module<>nil) {and (ID<>0)} then
  1996. S:=S+NameAndExtOf(Module^)+'('+IntToStr(Row)+') ';
  1997. if Text<>nil then S:=S+Text^;
  1998. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  1999. GetText:=S;
  2000. end;
  2001. {$endif}
  2002. constructor TProgramInfoWindow.Init;
  2003. var R,R2: TRect;
  2004. HSB,VSB: PScrollBar;
  2005. ST: PStaticText;
  2006. C: word;
  2007. const White = 15;
  2008. begin
  2009. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-13;
  2010. inherited Init(R, dialog_programinformation, wnNoNumber);
  2011. HelpCtx:=hcInfoWindow;
  2012. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+3;
  2013. C:=((Desktop^.GetColor(32+6) and $f0) or White)*256+Desktop^.GetColor(32+6);
  2014. New(InfoST, Init(R,'', C, false)); InfoST^.GrowMode:=gfGrowHiX;
  2015. Insert(InfoST);
  2016. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,3); R.B.Y:=R.A.Y+1;
  2017. New(ST, Init(R, CharStr('Ä', MaxViewWidth))); ST^.GrowMode:=gfGrowHiX; Insert(ST);
  2018. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,4);
  2019. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  2020. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  2021. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  2022. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  2023. New(LogLB, Init(R,HSB,VSB));
  2024. LogLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2025. LogLB^.Transparent:=true;
  2026. Insert(LogLB);
  2027. Update;
  2028. end;
  2029. constructor TProgramInfoWindow.Load(var S : TStream);
  2030. begin
  2031. inherited Load(S);
  2032. GetSubViewPtr(S,InfoST);
  2033. GetSubViewPtr(S,LogLB);
  2034. end;
  2035. procedure TProgramInfoWindow.Store(var S : TStream);
  2036. begin
  2037. inherited Store(S);
  2038. PutSubViewPtr(S,InfoST);
  2039. PutSubViewPtr(S,LogLB);
  2040. end;
  2041. procedure TProgramInfoWindow.AddMessage(AClass: longint; Msg, Module: string; Line, Column: longint);
  2042. begin
  2043. if AClass>=V_Info then Line:=0;
  2044. LogLB^.AddItem(New(PCompilerMessage, Init(AClass, Msg, LogLB^.AddModuleName(Module), Line, Column)));
  2045. end;
  2046. procedure TProgramInfoWindow.ClearMessages;
  2047. begin
  2048. LogLB^.Clear;
  2049. ReDraw;
  2050. end;
  2051. procedure TProgramInfoWindow.SizeLimits(var Min, Max: TPoint);
  2052. begin
  2053. inherited SizeLimits(Min,Max);
  2054. Min.X:=30; Min.Y:=9;
  2055. end;
  2056. procedure TProgramInfoWindow.Close;
  2057. begin
  2058. Hide;
  2059. end;
  2060. procedure TProgramInfoWindow.HandleEvent(var Event: TEvent);
  2061. begin
  2062. case Event.What of
  2063. evBroadcast :
  2064. case Event.Command of
  2065. cmUpdate :
  2066. Update;
  2067. end;
  2068. end;
  2069. inherited HandleEvent(Event);
  2070. end;
  2071. procedure TProgramInfoWindow.Update;
  2072. begin
  2073. ClearFormatParams;
  2074. AddFormatParamStr(label_proginfo_currentmodule);
  2075. AddFormatParamStr(MainFile);
  2076. AddFormatParamStr(label_proginfo_lastexitcode);
  2077. AddFormatParamInt(LastExitCode);
  2078. AddFormatParamStr(label_proginfo_availablememory);
  2079. AddFormatParamInt(MemAvail div 1024);
  2080. InfoST^.SetText(
  2081. FormatStrF(
  2082. {#13+ }
  2083. '%24s : %s'#13+
  2084. '%24s : %d'#13+
  2085. '%24s : %5d'+'K'+#13+
  2086. '',
  2087. FormatParams)
  2088. );
  2089. end;
  2090. destructor TProgramInfoWindow.Done;
  2091. begin
  2092. inherited Done;
  2093. ProgramInfoWindow:=nil;
  2094. end;
  2095. constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
  2096. begin
  2097. inherited Init(Bounds);
  2098. Options:=Options or ofSelectable or ofFirstClick or ofPreProcess or ofPostProcess;
  2099. GrowMode:=gfGrowHiX+gfGrowHiY+gfGrowRel;
  2100. TabDefs:=ATabDef;
  2101. ActiveDef:=-1;
  2102. SelectTab(0);
  2103. ReDraw;
  2104. end;
  2105. function TTab.TabCount: integer;
  2106. var i: integer;
  2107. P: PTabDef;
  2108. begin
  2109. I:=0; P:=TabDefs;
  2110. while (P<>nil) do
  2111. begin
  2112. Inc(I);
  2113. P:=P^.Next;
  2114. end;
  2115. TabCount:=I;
  2116. end;
  2117. function TTab.AtTab(Index: integer): PTabDef;
  2118. var i: integer;
  2119. P: PTabDef;
  2120. begin
  2121. i:=0; P:=TabDefs;
  2122. while (I<Index) do
  2123. begin
  2124. if P=nil then RunError($AA);
  2125. P:=P^.Next;
  2126. Inc(i);
  2127. end;
  2128. AtTab:=P;
  2129. end;
  2130. procedure TTab.SelectTab(Index: integer);
  2131. var P: PTabItem;
  2132. V: PView;
  2133. begin
  2134. if ActiveDef<>Index then
  2135. begin
  2136. if Owner<>nil then Owner^.Lock;
  2137. Lock;
  2138. { --- Update --- }
  2139. if TabDefs<>nil then
  2140. begin
  2141. DefCount:=1;
  2142. while AtTab(DefCount-1)^.Next<>nil do Inc(DefCount);
  2143. end
  2144. else DefCount:=0;
  2145. if ActiveDef<>-1 then
  2146. begin
  2147. P:=AtTab(ActiveDef)^.Items;
  2148. while P<>nil do
  2149. begin
  2150. if P^.View<>nil then Delete(P^.View);
  2151. P:=P^.Next;
  2152. end;
  2153. end;
  2154. ActiveDef:=Index;
  2155. P:=AtTab(ActiveDef)^.Items;
  2156. while P<>nil do
  2157. begin
  2158. if P^.View<>nil then Insert(P^.View);
  2159. P:=P^.Next;
  2160. end;
  2161. V:=AtTab(ActiveDef)^.DefItem;
  2162. if V<>nil then V^.Select;
  2163. ReDraw;
  2164. { --- Update --- }
  2165. UnLock;
  2166. if Owner<>nil then Owner^.UnLock;
  2167. DrawView;
  2168. end;
  2169. end;
  2170. procedure TTab.ChangeBounds(var Bounds: TRect);
  2171. var D: TPoint;
  2172. procedure DoCalcChange(P: PView); {$ifndef FPC}far;{$endif}
  2173. var
  2174. R: TRect;
  2175. begin
  2176. if P^.Owner=nil then Exit; { it think this is a bug in TV }
  2177. P^.CalcBounds(R, D);
  2178. P^.ChangeBounds(R);
  2179. end;
  2180. var
  2181. P: PTabItem;
  2182. I: integer;
  2183. begin
  2184. D.X := Bounds.B.X - Bounds.A.X - Size.X;
  2185. D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
  2186. inherited ChangeBounds(Bounds);
  2187. for I:=0 to TabCount-1 do
  2188. if I<>ActiveDef then
  2189. begin
  2190. P:=AtTab(I)^.Items;
  2191. while P<>nil do
  2192. begin
  2193. if P^.View<>nil then DoCalcChange(P^.View);
  2194. P:=P^.Next;
  2195. end;
  2196. end;
  2197. end;
  2198. procedure TTab.SelectNextTab(Forwards: boolean);
  2199. var Index: integer;
  2200. begin
  2201. Index:=ActiveDef;
  2202. if Index=-1 then Exit;
  2203. if Forwards then Inc(Index) else Dec(Index);
  2204. if Index<0 then Index:=DefCount-1 else
  2205. if Index>DefCount-1 then Index:=0;
  2206. SelectTab(Index);
  2207. end;
  2208. procedure TTab.HandleEvent(var Event: TEvent);
  2209. var Index : integer;
  2210. I : integer;
  2211. X : integer;
  2212. Len : byte;
  2213. P : TPoint;
  2214. V : PView;
  2215. CallOrig: boolean;
  2216. LastV : PView;
  2217. FirstV: PView;
  2218. function FirstSelectable: PView;
  2219. var
  2220. FV : PView;
  2221. begin
  2222. FV := First;
  2223. while (FV<>nil) and ((FV^.Options and ofSelectable)=0) and (FV<>Last) do
  2224. FV:=FV^.Next;
  2225. if FV<>nil then
  2226. if (FV^.Options and ofSelectable)=0 then FV:=nil;
  2227. FirstSelectable:=FV;
  2228. end;
  2229. function LastSelectable: PView;
  2230. var
  2231. LV : PView;
  2232. begin
  2233. LV := Last;
  2234. while (LV<>nil) and ((LV^.Options and ofSelectable)=0) and (LV<>First) do
  2235. LV:=LV^.Prev;
  2236. if LV<>nil then
  2237. if (LV^.Options and ofSelectable)=0 then LV:=nil;
  2238. LastSelectable:=LV;
  2239. end;
  2240. begin
  2241. if (Event.What and evMouseDown)<>0 then
  2242. begin
  2243. MakeLocal(Event.Where,P);
  2244. if P.Y<3 then
  2245. begin
  2246. Index:=-1; X:=1;
  2247. for i:=0 to DefCount-1 do
  2248. begin
  2249. Len:=CStrLen(AtTab(i)^.Name^);
  2250. if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
  2251. X:=X+Len+3;
  2252. end;
  2253. if Index<>-1 then
  2254. SelectTab(Index);
  2255. end;
  2256. end;
  2257. if Event.What=evKeyDown then
  2258. begin
  2259. Index:=-1;
  2260. case Event.KeyCode of
  2261. kbCtrlTab :
  2262. begin
  2263. SelectNextTab((Event.KeyShift and kbShift)=0);
  2264. ClearEvent(Event);
  2265. end;
  2266. kbTab,kbShiftTab :
  2267. if GetState(sfSelected) then
  2268. begin
  2269. if Current<>nil then
  2270. begin
  2271. LastV:=LastSelectable; FirstV:=FirstSelectable;
  2272. if ((Current=LastV) or (Current=PLabel(LastV)^.Link)) and (Event.KeyCode=kbShiftTab) then
  2273. begin
  2274. if Owner<>nil then Owner^.SelectNext(true);
  2275. end else
  2276. if ((Current=FirstV) or (Current=PLabel(FirstV)^.Link)) and (Event.KeyCode=kbTab) then
  2277. begin
  2278. Lock;
  2279. if Owner<>nil then Owner^.SelectNext(false);
  2280. UnLock;
  2281. end else
  2282. SelectNext(Event.KeyCode=kbShiftTab);
  2283. ClearEvent(Event);
  2284. end;
  2285. end;
  2286. else
  2287. for I:=0 to DefCount-1 do
  2288. begin
  2289. if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut
  2290. then begin
  2291. Index:=I;
  2292. ClearEvent(Event);
  2293. Break;
  2294. end;
  2295. end;
  2296. end;
  2297. if Index<>-1 then
  2298. begin
  2299. Select;
  2300. SelectTab(Index);
  2301. V:=AtTab(ActiveDef)^.DefItem;
  2302. if V<>nil then V^.Focus;
  2303. end;
  2304. end;
  2305. CallOrig:=true;
  2306. if Event.What=evKeyDown then
  2307. begin
  2308. if ((Owner<>nil) and (Owner^.Phase=phPostProcess) and (GetAltChar(Event.KeyCode)<>#0)) or GetState(sfFocused)
  2309. then
  2310. else CallOrig:=false;
  2311. end;
  2312. if CallOrig then inherited HandleEvent(Event);
  2313. end;
  2314. function TTab.GetPalette: PPalette;
  2315. begin
  2316. GetPalette:=nil;
  2317. end;
  2318. procedure TTab.Draw;
  2319. var B : TDrawBuffer;
  2320. i : integer;
  2321. C1,C2,C3,C : word;
  2322. HeaderLen : integer;
  2323. X,X2 : integer;
  2324. Name : PString;
  2325. ActiveKPos : integer;
  2326. ActiveVPos : integer;
  2327. FC : char;
  2328. ClipR : TRect;
  2329. procedure SWriteBuf(X,Y,W,H: integer; var Buf);
  2330. var i: integer;
  2331. begin
  2332. if Y+H>Size.Y then H:=Size.Y-Y;
  2333. if X+W>Size.X then W:=Size.X-X;
  2334. if Buffer=nil then WriteBuf(X,Y,W,H,Buf)
  2335. else for i:=1 to H do
  2336. Move(Buf,Buffer^[X+(Y+i-1)*Size.X],W*2);
  2337. end;
  2338. procedure ClearBuf;
  2339. begin
  2340. MoveChar(B,' ',C1,Size.X);
  2341. end;
  2342. begin
  2343. if InDraw then Exit;
  2344. InDraw:=true;
  2345. { - Start of TGroup.Draw - }
  2346. if Buffer = nil then
  2347. begin
  2348. GetBuffer;
  2349. end;
  2350. { - Start of TGroup.Draw - }
  2351. C1:=GetColor(1); C2:=(GetColor(7) and $f0 or $08)+GetColor(9)*256; C3:=GetColor(8)+GetColor({9}8)*256;
  2352. HeaderLen:=0; for i:=0 to DefCount-1 do HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name^)+3; Dec(HeaderLen);
  2353. if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
  2354. { --- 1. sor --- }
  2355. ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[HeaderLen+1],'³',C1,1);
  2356. X:=1;
  2357. for i:=0 to DefCount-1 do
  2358. begin
  2359. Name:=AtTab(i)^.Name; X2:=CStrLen(Name^);
  2360. if i=ActiveDef
  2361. then begin
  2362. ActiveKPos:=X-1;
  2363. ActiveVPos:=X+X2+2;
  2364. if GetState(sfFocused) then C:=C3 else C:=C2;
  2365. end
  2366. else C:=C2;
  2367. MoveCStr(B[X],' '+Name^+' ',C); X:=X+X2+3;
  2368. MoveChar(B[X-1],'³',C1,1);
  2369. end;
  2370. SWriteBuf(0,1,Size.X,1,B);
  2371. { --- 0. sor --- }
  2372. ClearBuf; MoveChar(B[0],'Ú',C1,1);
  2373. X:=1;
  2374. for i:=0 to DefCount-1 do
  2375. begin
  2376. if I<ActiveDef then FC:='Ú'
  2377. else FC:='¿';
  2378. X2:=CStrLen(AtTab(i)^.Name^)+2;
  2379. MoveChar(B[X+X2],{'Â'}FC,C1,1);
  2380. if i=DefCount-1 then X2:=X2+1;
  2381. if X2>0 then
  2382. MoveChar(B[X],'Ä',C1,X2);
  2383. X:=X+X2+1;
  2384. end;
  2385. MoveChar(B[HeaderLen+1],'¿',C1,1);
  2386. MoveChar(B[ActiveKPos],'Ú',C1,1); MoveChar(B[ActiveVPos],'¿',C1,1);
  2387. SWriteBuf(0,0,Size.X,1,B);
  2388. { --- 2. sor --- }
  2389. MoveChar(B[1],'Ä',C1,Max(HeaderLen,0)); MoveChar(B[HeaderLen+2],'Ä',C1,Max(Size.X-HeaderLen-3,0));
  2390. MoveChar(B[Size.X-1],'¿',C1,1);
  2391. MoveChar(B[ActiveKPos],'Ù',C1,1);
  2392. if ActiveDef=0 then MoveChar(B[0],'³',C1,1)
  2393. else MoveChar(B[0],{'Ã'}'Ú',C1,1);
  2394. MoveChar(B[HeaderLen+1],'Ä'{'Á'},C1,1); MoveChar(B[ActiveVPos],'À',C1,1);
  2395. MoveChar(B[ActiveKPos+1],' ',C1,Max(ActiveVPos-ActiveKPos-1,0));
  2396. SWriteBuf(0,2,Size.X,1,B);
  2397. { --- marad‚k sor --- }
  2398. ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[Size.X-1],'³',C1,1);
  2399. SWriteBuf(0,3,Size.X,Size.Y-4,B);
  2400. { --- Size.X . sor --- }
  2401. MoveChar(B[0],'À',C1,1); MoveChar(B[1],'Ä',C1,Max(Size.X-2,0)); MoveChar(B[Size.X-1],'Ù',C1,1);
  2402. SWriteBuf(0,Size.Y-1,Size.X,1,B);
  2403. { - End of TGroup.Draw - }
  2404. if Buffer <> nil then
  2405. begin
  2406. Lock;
  2407. Redraw;
  2408. UnLock;
  2409. end;
  2410. if Buffer <> nil then WriteBuf(0, 0, Size.X, Size.Y, Buffer^) else
  2411. begin
  2412. GetClipRect(ClipR);
  2413. Redraw;
  2414. GetExtent(ClipR);
  2415. end;
  2416. { - End of TGroup.Draw - }
  2417. InDraw:=false;
  2418. end;
  2419. function TTab.Valid(Command: Word): Boolean;
  2420. var PT : PTabDef;
  2421. PI : PTabItem;
  2422. OK : boolean;
  2423. begin
  2424. OK:=true;
  2425. PT:=TabDefs;
  2426. while (PT<>nil) and (OK=true) do
  2427. begin
  2428. PI:=PT^.Items;
  2429. while (PI<>nil) and (OK=true) do
  2430. begin
  2431. if PI^.View<>nil then OK:=OK and PI^.View^.Valid(Command);
  2432. PI:=PI^.Next;
  2433. end;
  2434. PT:=PT^.Next;
  2435. end;
  2436. Valid:=OK;
  2437. end;
  2438. procedure TTab.SetState(AState: Word; Enable: Boolean);
  2439. begin
  2440. inherited SetState(AState,Enable);
  2441. if (AState and sfFocused)<>0 then DrawView;
  2442. end;
  2443. destructor TTab.Done;
  2444. var P,X: PTabDef;
  2445. procedure DeleteViews(P: PView); {$ifndef FPC}far;{$endif}
  2446. begin
  2447. if P<>nil then Delete(P);
  2448. end;
  2449. begin
  2450. ForEach(@DeleteViews);
  2451. inherited Done;
  2452. P:=TabDefs;
  2453. while P<>nil do
  2454. begin
  2455. X:=P^.Next;
  2456. DisposeTabDef(P);
  2457. P:=X;
  2458. end;
  2459. end;
  2460. constructor TScreenView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  2461. AScreen: PScreen);
  2462. begin
  2463. inherited Init(Bounds,AHScrollBar,AVScrollBar);
  2464. Screen:=AScreen;
  2465. if Screen=nil then
  2466. Fail;
  2467. SetState(sfCursorVis,true);
  2468. Update;
  2469. end;
  2470. procedure TScreenView.Update;
  2471. begin
  2472. SetLimit(UserScreen^.GetWidth,UserScreen^.GetHeight);
  2473. DrawView;
  2474. end;
  2475. procedure TScreenView.HandleEvent(var Event: TEvent);
  2476. begin
  2477. case Event.What of
  2478. evBroadcast :
  2479. case Event.Command of
  2480. cmUpdate : Update;
  2481. end;
  2482. end;
  2483. inherited HandleEvent(Event);
  2484. end;
  2485. procedure TScreenView.Draw;
  2486. var B: TDrawBuffer;
  2487. X,Y: integer;
  2488. Text,Attr: string;
  2489. P: TPoint;
  2490. begin
  2491. Screen^.GetCursorPos(P);
  2492. for Y:=Delta.Y to Delta.Y+Size.Y-1 do
  2493. begin
  2494. if Y<Screen^.GetHeight then
  2495. Screen^.GetLine(Y,Text,Attr)
  2496. else
  2497. begin Text:=''; Attr:=''; end;
  2498. Text:=copy(Text,Delta.X+1,255); Attr:=copy(Attr,Delta.X+1,255);
  2499. MoveChar(B,' ',0,Size.X);
  2500. for X:=1 to length(Text) do
  2501. MoveChar(B[X-1],Text[X],ord(Attr[X]),1);
  2502. WriteLine(0,Y-Delta.Y,Size.X,1,B);
  2503. end;
  2504. SetCursor(P.X-Delta.X,P.Y-Delta.Y);
  2505. end;
  2506. constructor TScreenWindow.Init(AScreen: PScreen; ANumber: integer);
  2507. var R: TRect;
  2508. VSB,HSB: PScrollBar;
  2509. begin
  2510. Desktop^.GetExtent(R);
  2511. inherited Init(R, dialog_userscreen, ANumber);
  2512. Options:=Options or ofTileAble;
  2513. GetExtent(R); R.Grow(-1,-1); R.Move(1,0); R.A.X:=R.B.X-1;
  2514. New(VSB, Init(R)); VSB^.Options:=VSB^.Options or ofPostProcess;
  2515. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  2516. GetExtent(R); R.Grow(-1,-1); R.Move(0,1); R.A.Y:=R.B.Y-1;
  2517. New(HSB, Init(R)); HSB^.Options:=HSB^.Options or ofPostProcess;
  2518. HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  2519. GetExtent(R); R.Grow(-1,-1);
  2520. New(ScreenView, Init(R, HSB, VSB, AScreen));
  2521. ScreenView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2522. Insert(ScreenView);
  2523. UserScreenWindow:=@Self;
  2524. end;
  2525. destructor TScreenWindow.Done;
  2526. begin
  2527. inherited Done;
  2528. UserScreenWindow:=nil;
  2529. end;
  2530. const InTranslate : boolean = false;
  2531. procedure TranslateMouseClick(View: PView; var Event: TEvent);
  2532. procedure TranslateAction(Action: integer);
  2533. var E: TEvent;
  2534. begin
  2535. if Action<>acNone then
  2536. begin
  2537. E:=Event;
  2538. E.What:=evMouseDown; E.Buttons:=mbLeftButton;
  2539. View^.HandleEvent(E);
  2540. Event.What:=evCommand;
  2541. Event.Command:=ActionCommands[Action];
  2542. end;
  2543. end;
  2544. begin
  2545. if InTranslate then Exit;
  2546. InTranslate:=true;
  2547. case Event.What of
  2548. evMouseDown :
  2549. if (GetShiftState and kbAlt)<>0 then
  2550. TranslateAction(AltMouseAction) else
  2551. if (GetShiftState and kbCtrl)<>0 then
  2552. TranslateAction(CtrlMouseAction);
  2553. end;
  2554. InTranslate:=false;
  2555. end;
  2556. function GetNextEditorBounds(var Bounds: TRect): boolean;
  2557. var P: PView;
  2558. begin
  2559. P:=Desktop^.Current;
  2560. while P<>nil do
  2561. begin
  2562. if P^.HelpCtx=hcSourceWindow then Break;
  2563. P:=P^.NextView;
  2564. if P=Desktop^.Current then
  2565. begin
  2566. P:=nil;
  2567. break;
  2568. end;
  2569. end;
  2570. if P=nil then Desktop^.GetExtent(Bounds) else
  2571. begin
  2572. P^.GetBounds(Bounds);
  2573. Inc(Bounds.A.X); Inc(Bounds.A.Y);
  2574. end;
  2575. GetNextEditorBounds:=P<>nil;
  2576. end;
  2577. function IOpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer; ShowIt: boolean): PSourceWindow;
  2578. var R: TRect;
  2579. W: PSourceWindow;
  2580. begin
  2581. if Assigned(Bounds) then R.Copy(Bounds^) else
  2582. GetNextEditorBounds(R);
  2583. PushStatus(FormatStrStr(msg_openingsourcefile,SmartPath(FileName)));
  2584. New(W, Init(R, FileName));
  2585. if ShowIt=false then
  2586. W^.Hide;
  2587. if W<>nil then
  2588. begin
  2589. if (CurX<>0) or (CurY<>0) then
  2590. with W^.Editor^ do
  2591. begin
  2592. SetCurPtr(CurX,CurY);
  2593. TrackCursor(true);
  2594. end;
  2595. W^.HelpCtx:=hcSourceWindow;
  2596. Desktop^.Insert(W);
  2597. Message(Application,evBroadcast,cmUpdate,nil);
  2598. end;
  2599. PopStatus;
  2600. IOpenEditorWindow:=W;
  2601. end;
  2602. function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer): PSourceWindow;
  2603. begin
  2604. OpenEditorWindow:=IOpenEditorWindow(Bounds,FileName,CurX,CurY,true);
  2605. end;
  2606. function SearchOnDesktop(FileName : string;tryexts:boolean) : PSourceWindow;
  2607. var
  2608. D,DS : DirStr;
  2609. N,NS : NameStr;
  2610. E,ES : ExtStr;
  2611. SName : string;
  2612. function IsSearchedFile(W : PSourceWindow) : boolean;
  2613. var Found: boolean;
  2614. begin
  2615. Found:=false;
  2616. if (W<>nil) and (W^.HelpCtx=hcSourceWindow) then
  2617. begin
  2618. if (D='') then
  2619. SName:=NameAndExtOf(PSourceWindow(W)^.Editor^.FileName)
  2620. else
  2621. SName:=PSourceWindow(W)^.Editor^.FileName;
  2622. FSplit(SName,DS,NS,ES);
  2623. SName:=UpcaseStr(NS+ES);
  2624. if (E<>'') or (not tryexts) then
  2625. begin
  2626. if D<>'' then
  2627. Found:=UpCaseStr(DS)+SName=UpcaseStr(D+N+E)
  2628. else
  2629. Found:=SName=UpcaseStr(N+E);
  2630. end
  2631. else
  2632. begin
  2633. Found:=SName=UpcaseStr(N+'.pp');
  2634. if Found=false then
  2635. Found:=SName=UpcaseStr(N+'.pas');
  2636. end;
  2637. end;
  2638. IsSearchedFile:=found;
  2639. end;
  2640. function IsSearchedSource(P: PView) : boolean; {$ifndef FPC}far;{$endif}
  2641. begin
  2642. if assigned(P) and
  2643. (TypeOf(P^)=TypeOf(TSourceWindow)) then
  2644. IsSearchedSource:=IsSearchedFile(PSourceWindow(P))
  2645. else
  2646. IsSearchedSource:=false;
  2647. end;
  2648. begin
  2649. FSplit(FileName,D,N,E);
  2650. SearchOnDesktop:=PSourceWindow(Desktop^.FirstThat(@IsSearchedSource));
  2651. end;
  2652. function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts:boolean): PSourceWindow;
  2653. begin
  2654. TryToOpenFile:=ITryToOpenFile(Bounds,FileName,CurX,CurY,tryexts,true,false);
  2655. end;
  2656. function LocateSingleSourceFile(const FileName: string; tryexts: boolean): string;
  2657. var D : DirStr;
  2658. N : NameStr;
  2659. E : ExtStr;
  2660. function CheckDir(NewDir: DirStr; NewName: NameStr; NewExt: ExtStr): boolean;
  2661. var OK: boolean;
  2662. begin
  2663. NewDir:=CompleteDir(NewDir);
  2664. OK:=ExistsFile(NewDir+NewName+NewExt);
  2665. if OK then begin D:=NewDir; N:=NewName; E:=NewExt; end;
  2666. CheckDir:=OK;
  2667. end;
  2668. function CheckExt(NewExt: ExtStr): boolean;
  2669. var OK: boolean;
  2670. begin
  2671. OK:=false;
  2672. if D<>'' then OK:=CheckDir(D,N,NewExt) else
  2673. if CheckDir('.'+DirSep,N,NewExt) then OK:=true;
  2674. CheckExt:=OK;
  2675. end;
  2676. function TryToLocateIn(const DD : dirstr): boolean;
  2677. var Found: boolean;
  2678. begin
  2679. D:=CompleteDir(DD);
  2680. Found:=true;
  2681. if (E<>'') or (not tryexts) then
  2682. Found:=CheckExt(E)
  2683. else
  2684. if CheckExt('.pp') then
  2685. Found:=true
  2686. else
  2687. if CheckExt('.pas') then
  2688. Found:=true
  2689. else
  2690. if CheckExt('.inc') then
  2691. Found:=true
  2692. { try also without extension if no other exist }
  2693. else
  2694. if CheckExt('') then
  2695. Found:=true
  2696. else
  2697. Found:=false;
  2698. TryToLocateIn:=Found;
  2699. end;
  2700. var Path,DrStr: string;
  2701. Found: boolean;
  2702. begin
  2703. FSplit(FileName,D,N,E);
  2704. Found:=CheckDir(D,N,E);
  2705. if not found then
  2706. Found:=TryToLocateIn('.');
  2707. DrStr:=GetSourceDirectories;
  2708. if not Found then
  2709. While pos(ListSeparator,DrStr)>0 do
  2710. Begin
  2711. Found:=TryToLocateIn(Copy(DrStr,1,pos(ListSeparator,DrStr)-1));
  2712. if Found then
  2713. break;
  2714. DrStr:=Copy(DrStr,pos(ListSeparator,DrStr)+1,High(DrStr));
  2715. End;
  2716. if Found then Path:=FExpand(D+N+E) else Path:='';
  2717. LocateSingleSourceFile:=Path;
  2718. end;
  2719. function LocateSourceFile(const FileName: string; tryexts: boolean): string;
  2720. var P: integer;
  2721. FN,S: string;
  2722. FFN: string;
  2723. begin
  2724. FN:=FileName;
  2725. repeat
  2726. P:=Pos(ListSeparator,FN); if P=0 then P:=length(FN)+1;
  2727. S:=copy(FN,1,P-1); Delete(FN,1,P);
  2728. FFN:=LocateSingleSourceFile(S,tryexts);
  2729. until (FFN<>'') or (FN='');
  2730. LocateSourceFile:=FFN;
  2731. end;
  2732. function ITryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts:boolean;
  2733. ShowIt,ForceNewWindow: boolean): PSourceWindow;
  2734. var
  2735. W : PSourceWindow;
  2736. DrStr: string;
  2737. begin
  2738. W:=nil;
  2739. if ForceNewWindow then
  2740. W:=nil
  2741. else
  2742. W:=SearchOnDesktop(FileName,tryexts);
  2743. if W<>nil then
  2744. begin
  2745. NewEditorOpened:=false;
  2746. { if assigned(Bounds) then
  2747. W^.ChangeBounds(Bounds^);}
  2748. W^.Editor^.SetCurPtr(CurX,CurY);
  2749. end
  2750. else
  2751. begin
  2752. DrStr:=LocateSourceFile(FileName,tryexts);
  2753. if DrStr<>'' then
  2754. W:=IOpenEditorWindow(Bounds,DrStr,CurX,CurY,ShowIt);
  2755. NewEditorOpened:=W<>nil;
  2756. if assigned(W) then
  2757. W^.Editor^.SetCurPtr(CurX,CurY);
  2758. end;
  2759. ITryToOpenFile:=W;
  2760. end;
  2761. function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
  2762. var OK: boolean;
  2763. E: PFileEditor;
  2764. R: TRect;
  2765. begin
  2766. R.Assign(0,0,0,0);
  2767. New(E, Init(R,nil,nil,nil,nil,FileName));
  2768. OK:=E<>nil;
  2769. if OK then
  2770. begin
  2771. PushStatus(FormatStrStr(msg_readingfileineditor,FileName));
  2772. OK:=E^.LoadFile;
  2773. PopStatus;
  2774. end;
  2775. if OK then
  2776. begin
  2777. Editor^.Lock;
  2778. E^.SelectAll(true);
  2779. Editor^.InsertFrom(E);
  2780. Editor^.SetCurPtr(0,0);
  2781. Editor^.SelectAll(false);
  2782. Editor^.UnLock;
  2783. Dispose(E, Done);
  2784. end;
  2785. StartEditor:=OK;
  2786. end;
  2787. constructor TTextScroller.Init(var Bounds: TRect; ASpeed: integer; AText: PUnsortedStringCollection);
  2788. begin
  2789. inherited Init(Bounds,'');
  2790. EventMask:=EventMask or evIdle;
  2791. Speed:=ASpeed; Lines:=AText;
  2792. end;
  2793. function TTextScroller.GetLineCount: integer;
  2794. var Count: integer;
  2795. begin
  2796. if Lines=nil then Count:=0 else
  2797. Count:=Lines^.Count;
  2798. GetLineCount:=Count;
  2799. end;
  2800. function TTextScroller.GetLine(I: integer): string;
  2801. var S: string;
  2802. begin
  2803. if I<Lines^.Count then
  2804. S:=GetStr(Lines^.At(I))
  2805. else
  2806. S:='';
  2807. GetLine:=S;
  2808. end;
  2809. procedure TTextScroller.HandleEvent(var Event: TEvent);
  2810. begin
  2811. case Event.What of
  2812. evIdle :
  2813. Update;
  2814. end;
  2815. inherited HandleEvent(Event);
  2816. end;
  2817. procedure TTextScroller.Update;
  2818. begin
  2819. if abs(GetDosTicks-LastTT)<Speed then Exit;
  2820. Scroll;
  2821. LastTT:=GetDosTicks;
  2822. end;
  2823. procedure TTextScroller.Reset;
  2824. begin
  2825. TopLine:=0;
  2826. LastTT:=GetDosTicks;
  2827. DrawView;
  2828. end;
  2829. procedure TTextScroller.Scroll;
  2830. begin
  2831. Inc(TopLine);
  2832. if TopLine>=GetLineCount then
  2833. Reset;
  2834. DrawView;
  2835. end;
  2836. procedure TTextScroller.Draw;
  2837. var B: TDrawBuffer;
  2838. C: word;
  2839. Count,Y: integer;
  2840. S: string;
  2841. begin
  2842. C:=GetColor(1);
  2843. Count:=GetLineCount;
  2844. for Y:=0 to Size.Y-1 do
  2845. begin
  2846. if Count=0 then S:='' else
  2847. S:=GetLine((TopLine+Y) mod Count);
  2848. if copy(S,1,1)=^C then
  2849. S:=CharStr(' ',Max(0,(Size.X-(length(S)-1)) div 2))+copy(S,2,255);
  2850. MoveChar(B,' ',C,Size.X);
  2851. MoveStr(B,S,C);
  2852. WriteLine(0,Y,Size.X,1,B);
  2853. end;
  2854. end;
  2855. destructor TTextScroller.Done;
  2856. begin
  2857. inherited Done;
  2858. if Lines<>nil then Dispose(Lines, Done);
  2859. end;
  2860. constructor TFPAboutDialog.Init;
  2861. var R,R2: TRect;
  2862. C: PUnsortedStringCollection;
  2863. I: integer;
  2864. OSStr: string;
  2865. procedure AddLine(S: string);
  2866. begin
  2867. C^.Insert(NewStr(S));
  2868. end;
  2869. begin
  2870. OSStr:='';
  2871. {$ifdef go32v2}
  2872. OSStr:='Dos';
  2873. {$endif}
  2874. {$ifdef tp}
  2875. OSStr:='Dos';
  2876. {$endif}
  2877. {$ifdef linux}
  2878. OSStr:='Linux';
  2879. {$endif}
  2880. {$ifdef win32}
  2881. OSStr:='Win32';
  2882. {$endif}
  2883. {$ifdef os2}
  2884. OSStr:='OS/2';
  2885. {$endif}
  2886. {$ifdef FreeBSD}
  2887. OSStr:='FreeBSD';
  2888. {$endif}
  2889. R.Assign(0,0,38,14{$ifdef NODEBUG}-1{$endif});
  2890. inherited Init(R, dialog_about);
  2891. GetExtent(R); R.Grow(-3,-2);
  2892. R2.Copy(R); R2.B.Y:=R2.A.Y+1;
  2893. Insert(New(PStaticText, Init(R2, ^C'FreePascal IDE for '+OSStr)));
  2894. R2.Move(0,1);
  2895. Insert(New(PStaticText, Init(R2, ^C'Version '+VersionStr
  2896. {$ifdef FPC}+' '+{$i %date%}{$endif}
  2897. )));
  2898. R2.Move(0,1);
  2899. Insert(New(PStaticText, Init(R2, FormatStrStr2(^C'(%s %s)',label_about_compilerversion,Version_String))));
  2900. {$ifndef NODEBUG}
  2901. if pos('Fake',GDBVersion)=0 then
  2902. begin
  2903. R2.Move(0,1);
  2904. Insert(New(PStaticText, Init(R2, FormatStrStr2(^C'(%s %s)',label_about_debugger,GDBVersion))));
  2905. R2.Move(0,1);
  2906. end
  2907. else
  2908. {$endif NODEBUG}
  2909. R2.Move(0,2);
  2910. Insert(New(PStaticText, Init(R2, ^C'Copyright (C) 1998-2000 by')));
  2911. R2.Move(0,2);
  2912. Insert(New(PStaticText, Init(R2, ^C'B‚rczi G bor')));
  2913. R2.Move(0,1);
  2914. Insert(New(PStaticText, Init(R2, ^C'Pierre Muller')));
  2915. R2.Move(0,1);
  2916. Insert(New(PStaticText, Init(R2, ^C'and')));
  2917. R2.Move(0,1);
  2918. Insert(New(PStaticText, Init(R2, ^C'Peter Vreman')));
  2919. New(C, Init(50,10));
  2920. for I:=1 to 7 do
  2921. AddLine('');
  2922. AddLine(^C'< Original concept >');
  2923. AddLine(^C'Borland International, Inc.');
  2924. AddLine('');
  2925. AddLine(^C'< Compiler development >');
  2926. AddLine(^C'Carl-Eric Codere');
  2927. AddLine(^C'Daniel Mantione');
  2928. AddLine(^C'Florian Kl„mpfl');
  2929. AddLine(^C'Jonas Maebe');
  2930. AddLine(^C'Mich„el Van Canneyt');
  2931. AddLine(^C'Peter Vreman');
  2932. AddLine(^C'Pierre Muller');
  2933. AddLine('');
  2934. AddLine(^C'< IDE development >');
  2935. AddLine(^C'B‚rczi G bor');
  2936. AddLine(^C'Peter Vreman');
  2937. AddLine(^C'Pierre Muller');
  2938. AddLine('');
  2939. GetExtent(R);
  2940. R.Grow(-1,-1); Inc(R.A.Y,3);
  2941. New(Scroller, Init(R, 10, C));
  2942. Scroller^.Hide;
  2943. Insert(Scroller);
  2944. R.Move(0,-1); R.B.Y:=R.A.Y+1;
  2945. New(TitleST, Init(R, ^C'Team'));
  2946. TitleST^.Hide;
  2947. Insert(TitleST);
  2948. InsertOK(@Self);
  2949. end;
  2950. procedure TFPAboutDialog.ToggleInfo;
  2951. begin
  2952. if Scroller=nil then Exit;
  2953. if Scroller^.GetState(sfVisible) then
  2954. begin
  2955. Scroller^.Hide;
  2956. TitleST^.Hide;
  2957. end
  2958. else
  2959. begin
  2960. Scroller^.Reset;
  2961. Scroller^.Show;
  2962. TitleST^.Show;
  2963. end;
  2964. end;
  2965. procedure TFPAboutDialog.HandleEvent(var Event: TEvent);
  2966. begin
  2967. case Event.What of
  2968. evKeyDown :
  2969. case Event.KeyCode of
  2970. kbAltI : { just like in BP }
  2971. begin
  2972. ToggleInfo;
  2973. ClearEvent(Event);
  2974. end;
  2975. end;
  2976. end;
  2977. inherited HandleEvent(Event);
  2978. end;
  2979. constructor TFPASCIIChart.Init;
  2980. begin
  2981. inherited Init;
  2982. HelpCtx:=hcASCIITableWindow;
  2983. Number:=SearchFreeWindowNo;
  2984. ASCIIChart:=@Self;
  2985. end;
  2986. procedure TFPASCIIChart.Store(var S: TStream);
  2987. begin
  2988. inherited Store(S);
  2989. end;
  2990. constructor TFPASCIIChart.Load(var S: TStream);
  2991. begin
  2992. inherited Load(S);
  2993. end;
  2994. procedure TFPASCIIChart.HandleEvent(var Event: TEvent);
  2995. var W: PSourceWindow;
  2996. begin
  2997. case Event.What of
  2998. evKeyDown :
  2999. case Event.KeyCode of
  3000. kbEsc :
  3001. begin
  3002. Close;
  3003. ClearEvent(Event);
  3004. end;
  3005. end;
  3006. evCommand :
  3007. case Event.Command of
  3008. cmTransfer :
  3009. begin
  3010. W:=FirstEditorWindow;
  3011. if Assigned(W) and Assigned(Report) then
  3012. Message(W,evCommand,cmAddChar,pointer(ord(Report^.AsciiChar)));
  3013. ClearEvent(Event);
  3014. end;
  3015. end;
  3016. end;
  3017. inherited HandleEvent(Event);
  3018. end;
  3019. destructor TFPASCIIChart.Done;
  3020. begin
  3021. ASCIIChart:=nil;
  3022. inherited Done;
  3023. end;
  3024. function TVideoModeListBox.GetText(Item: pointer; MaxLen: sw_integer): string;
  3025. var P: PVideoModeList;
  3026. S: string;
  3027. begin
  3028. P:=Item;
  3029. S:=IntToStr(P^.Col)+'x'+IntToStr(P^.Row)+' ';
  3030. if P^.Color then
  3031. S:=S+'color'
  3032. else
  3033. S:=S+'mono';
  3034. GetText:=copy(S,1,MaxLen);
  3035. end;
  3036. constructor TFPDesktop.Init(var Bounds: TRect);
  3037. begin
  3038. inherited Init(Bounds);
  3039. end;
  3040. procedure TFPDesktop.InitBackground;
  3041. var AV: PANSIBackground;
  3042. FileName: string;
  3043. R: TRect;
  3044. begin
  3045. AV:=nil;
  3046. FileName:=LocateFile(BackgroundPath);
  3047. if FileName<>'' then
  3048. begin
  3049. GetExtent(R);
  3050. New(AV, Init(R));
  3051. AV^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3052. if AV^.LoadFile(FileName)=false then
  3053. begin
  3054. Dispose(AV, Done); AV:=nil;
  3055. end;
  3056. if Assigned(AV) then
  3057. Insert(AV);
  3058. end;
  3059. Background:=AV;
  3060. if Assigned(Background)=false then
  3061. inherited InitBackground;
  3062. end;
  3063. constructor TFPDesktop.Load(var S: TStream);
  3064. begin
  3065. inherited Load(S);
  3066. end;
  3067. procedure TFPDesktop.Store(var S: TStream);
  3068. begin
  3069. inherited Store(S);
  3070. end;
  3071. constructor TFPToolTip.Init(var Bounds: TRect; const AText: string; AAlign: TAlign);
  3072. begin
  3073. inherited Init(Bounds);
  3074. SetAlign(AAlign);
  3075. SetText(AText);
  3076. end;
  3077. procedure TFPToolTip.Draw;
  3078. var C: word;
  3079. procedure DrawLine(Y: integer; S: string);
  3080. var B: TDrawBuffer;
  3081. begin
  3082. S:=copy(S,1,Size.X-2);
  3083. case Align of
  3084. alLeft : S:=' '+S;
  3085. alRight : S:=LExpand(' '+S,Size.X);
  3086. alCenter : S:=Center(S,Size.X);
  3087. end;
  3088. MoveChar(B,' ',C,Size.X);
  3089. MoveStr(B,S,C);
  3090. WriteLine(0,Y,Size.X,1,B);
  3091. end;
  3092. var S: string;
  3093. Y: integer;
  3094. begin
  3095. C:=GetColor(1);
  3096. S:=GetText;
  3097. for Y:=0 to Size.Y-1 do
  3098. DrawLine(Y,S);
  3099. end;
  3100. function TFPToolTip.GetText: string;
  3101. begin
  3102. GetText:=GetStr(Text);
  3103. end;
  3104. procedure TFPToolTip.SetText(const AText: string);
  3105. begin
  3106. if AText<>GetText then
  3107. begin
  3108. if Assigned(Text) then DisposeStr(Text);
  3109. Text:=NewStr(AText);
  3110. DrawView;
  3111. end;
  3112. end;
  3113. function TFPToolTip.GetAlign: TAlign;
  3114. begin
  3115. GetAlign:=Align;
  3116. end;
  3117. procedure TFPToolTip.SetAlign(AAlign: TAlign);
  3118. begin
  3119. if AAlign<>Align then
  3120. begin
  3121. Align:=AAlign;
  3122. DrawView;
  3123. end;
  3124. end;
  3125. destructor TFPToolTip.Done;
  3126. begin
  3127. if Assigned(Text) then DisposeStr(Text); Text:=nil;
  3128. inherited Done;
  3129. end;
  3130. function TFPToolTip.GetPalette: PPalette;
  3131. const S: string[length(CFPToolTip)] = CFPToolTip;
  3132. begin
  3133. GetPalette:=@S;
  3134. end;
  3135. constructor TFPMemo.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  3136. PScrollBar; AIndicator: PIndicator);
  3137. begin
  3138. inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator,nil);
  3139. SetFlags(Flags and not (efPersistentBlocks) or efSyntaxHighlight);
  3140. end;
  3141. function TFPMemo.GetPalette: PPalette;
  3142. const P: string[length(CFPMemo)] = CFPMemo;
  3143. begin
  3144. GetPalette:=@P;
  3145. end;
  3146. function TFPMemo.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
  3147. begin
  3148. GetSpecSymbolCount:=0;
  3149. end;
  3150. function TFPMemo.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string;
  3151. begin
  3152. Abstract;
  3153. GetSpecSymbol:='';
  3154. end;
  3155. function TFPMemo.IsReservedWord(const S: string): boolean;
  3156. begin
  3157. IsReservedWord:=false;
  3158. end;
  3159. constructor TFPCodeMemo.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  3160. PScrollBar; AIndicator: PIndicator);
  3161. begin
  3162. inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator);
  3163. end;
  3164. function TFPCodeMemo.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
  3165. var Count: integer;
  3166. begin
  3167. case SpecClass of
  3168. ssCommentPrefix : Count:=3;
  3169. ssCommentSingleLinePrefix : Count:=1;
  3170. ssCommentSuffix : Count:=2;
  3171. ssStringPrefix : Count:=1;
  3172. ssStringSuffix : Count:=1;
  3173. ssAsmPrefix : Count:=1;
  3174. ssAsmSuffix : Count:=1;
  3175. ssDirectivePrefix : Count:=1;
  3176. ssDirectiveSuffix : Count:=1;
  3177. end;
  3178. GetSpecSymbolCount:=Count;
  3179. end;
  3180. function TFPCodeMemo.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string;
  3181. var S: string[20];
  3182. begin
  3183. case SpecClass of
  3184. ssCommentPrefix :
  3185. case Index of
  3186. 0 : S:='{';
  3187. 1 : S:='(*';
  3188. 2 : S:='//';
  3189. end;
  3190. ssCommentSingleLinePrefix :
  3191. case Index of
  3192. 0 : S:='//';
  3193. end;
  3194. ssCommentSuffix :
  3195. case Index of
  3196. 0 : S:='}';
  3197. 1 : S:='*)';
  3198. end;
  3199. ssStringPrefix :
  3200. S:='''';
  3201. ssStringSuffix :
  3202. S:='''';
  3203. ssAsmPrefix :
  3204. S:='asm';
  3205. ssAsmSuffix :
  3206. S:='end';
  3207. ssDirectivePrefix :
  3208. S:='{$';
  3209. ssDirectiveSuffix :
  3210. S:='}';
  3211. end;
  3212. GetSpecSymbol:=S;
  3213. end;
  3214. function TFPCodeMemo.IsReservedWord(const S: string): boolean;
  3215. begin
  3216. IsReservedWord:=IsFPReservedWord(S);
  3217. end;
  3218. {$ifdef VESA}
  3219. function VESASetVideoModeProc(const VideoMode: TVideoMode; Params: Longint): Boolean; {$ifndef FPC}far;{$endif}
  3220. begin
  3221. VESASetVideoModeProc:=VESASetMode(Params);
  3222. end;
  3223. procedure InitVESAScreenModes;
  3224. var ML: TVESAModeList;
  3225. MI: TVESAModeInfoBlock;
  3226. I: integer;
  3227. begin
  3228. if VESAInit=false then Exit;
  3229. if VESAGetModeList(ML)=false then Exit;
  3230. for I:=1 to ML.Count do
  3231. begin
  3232. if VESAGetModeInfo(ML.Modes[I],MI) then
  3233. with MI do
  3234. if (Attributes and vesa_vma_GraphicsMode)=0 then
  3235. RegisterVideoMode(XResolution,YResolution,
  3236. (Attributes and vesa_vma_ColorMode)<>0,{$ifdef FPC}@{$endif}VESASetVideoModeProc,ML.Modes[I]);
  3237. end;
  3238. end;
  3239. {$endif}
  3240. procedure NoDebugger;
  3241. begin
  3242. InformationBox(msg_nodebuggersupportavailable,nil);
  3243. end;
  3244. procedure RegisterFPViews;
  3245. begin
  3246. RegisterType(RSourceEditor);
  3247. RegisterType(RSourceWindow);
  3248. RegisterType(RFPHelpViewer);
  3249. RegisterType(RFPHelpWindow);
  3250. RegisterType(RClipboardWindow);
  3251. RegisterType(RMessageListBox);
  3252. RegisterType(RFPDesktop);
  3253. RegisterType(RGDBSourceEditor);
  3254. RegisterType(RGDBWindow);
  3255. RegisterType(RFPASCIIChart);
  3256. RegisterType(RProgramInfoWindow);
  3257. end;
  3258. END.
  3259. {
  3260. $Log$
  3261. Revision 1.5 2000-11-15 00:14:11 pierre
  3262. new merge
  3263. Revision 1.1.2.14 2000/11/14 09:08:49 marco
  3264. * First batch IDE renamefest
  3265. Revision 1.4 2000/11/13 17:37:42 pierre
  3266. merges from fixes branch
  3267. Revision 1.1.2.13 2000/11/06 16:55:48 pierre
  3268. * fix failure to recompile when file changed
  3269. Revision 1.3 2000/10/31 22:35:55 pierre
  3270. * New big merge from fixes branch
  3271. Revision 1.1.2.12 2000/10/31 07:54:24 pierre
  3272. enhance GDB Window
  3273. Revision 1.1.2.11 2000/10/26 00:04:36 pierre
  3274. + gdb prompt and FPC_BREAK_ERROR stop
  3275. Revision 1.1.2.10 2000/10/24 00:21:59 pierre
  3276. * fix the greyed save after window list box
  3277. Revision 1.1.2.9 2000/10/20 13:29:29 pierre
  3278. * fix bug 1184, only keyowrd for all mode are highlighted
  3279. Revision 1.1.2.8 2000/10/20 09:55:00 pierre
  3280. * fix GetEditorCurWord if tabs present
  3281. Revision 1.1.2.7 2000/10/18 21:53:27 pierre
  3282. * several Gabor fixes
  3283. Revision 1.2 2000/08/22 09:41:41 pierre
  3284. * first big merge from fixes branch
  3285. Revision 1.1.2.6 2000/08/21 21:23:27 pierre
  3286. * fix loading problem for sources in other dirs
  3287. Revision 1.1.2.5 2000/08/15 03:40:54 peter
  3288. [*] no more fatal exits when the IDE can't find the error file (containing
  3289. the redirected assembler/linker output) after compilation
  3290. [*] hidden windows are now added always at the end of the Window List
  3291. [*] TINIFile parsed entries encapsulated in string delimiters incorrectly
  3292. [*] selection was incorrectly adjusted when typing in overwrite mode
  3293. [*] the line wasn't expanded when it's end was reached in overw. mode
  3294. [*] the IDE now tries to locate source files also in the user specified
  3295. unit dirs (for ex. as a response to 'Open at cursor' (Ctrl+Enter) )
  3296. [*] 'Open at cursor' is now aware of the extension (if specified)
  3297. Revision 1.1.2.4 2000/08/04 14:05:19 michael
  3298. * Fixes from Gabor:
  3299. [*] the IDE now doesn't disable Compile|Make & Build when all windows
  3300. are closed, but there's still a primary file set
  3301. (set bug 1059 to fixed!)
  3302. [*] the IDE didn't read some compiler options correctly back from the
  3303. FP.CFG file, for ex. the linker options. Now it read everything
  3304. correctly, and also automatically handles smartlinking option synch-
  3305. ronization.
  3306. (set bug 1048 to fixed!)
  3307. Revision 1.1.2.3 2000/07/20 11:02:15 michael
  3308. + Fixes from gabor. See fixes.txt
  3309. Revision 1.1.2.2 2000/07/15 21:35:32 pierre
  3310. * Avoid asking twice for Unsaved New File at exit
  3311. * Load files without extensions at startup
  3312. Revision 1.1.2.1 2000/07/15 21:30:06 pierre
  3313. * Wrong commit text
  3314. Revision 1.1 2000/07/13 09:48:36 michael
  3315. + Initial import
  3316. Revision 1.73 2000/06/22 09:07:13 pierre
  3317. * Gabor changes: see fixes.txt
  3318. Revision 1.72 2000/06/16 08:50:42 pierre
  3319. + new bunch of Gabor's changes
  3320. Revision 1.71 2000/05/29 10:44:57 pierre
  3321. + New bunch of Gabor's changes: see fixes.txt
  3322. Revision 1.70 2000/05/16 21:50:53 pierre
  3323. * avoid to typecast the status line to a TWindow
  3324. Revision 1.69 2000/05/02 08:42:29 pierre
  3325. * new set of Gabor changes: see fixes.txt
  3326. Revision 1.68 2000/04/25 08:42:34 pierre
  3327. * New Gabor changes : see fixes.txt
  3328. Revision 1.67 2000/04/18 11:42:37 pierre
  3329. lot of Gabor changes : see fixes.txt
  3330. Revision 1.66 2000/03/23 22:22:25 pierre
  3331. * file loading problem fixed
  3332. Revision 1.65 2000/03/21 23:25:16 pierre
  3333. adapted to wcedit addition
  3334. Revision 1.64 2000/03/14 13:59:41 pierre
  3335. + add a warning if Changed on loading
  3336. Revision 1.63 2000/03/13 20:39:25 pierre
  3337. * one more try to get the menu update to work correctly
  3338. * breakpoint in red at loading
  3339. Revision 1.62 2000/03/07 21:50:38 pierre
  3340. * UpdateCommands changed again, still not correct :(
  3341. Revision 1.61 2000/03/01 22:32:48 pierre
  3342. * hopfully the bug on wrong Menu config fixed
  3343. Revision 1.60 2000/02/07 23:40:38 pierre
  3344. * avoid closing the StackWindow too early
  3345. Revision 1.59 2000/02/07 10:36:43 michael
  3346. + Something went wrong when unzipping
  3347. Revision 1.58 2000/02/06 23:42:47 pierre
  3348. + Use ErrorLine on GotoSource
  3349. Revision 1.57 2000/02/04 00:03:30 pierre
  3350. + SelectInDebugSession lets CPU and watches in front
  3351. Revision 1.56 2000/02/02 22:51:49 pierre
  3352. * use desktop^.current for GetNextEditorBounds
  3353. Revision 1.55 2000/02/01 10:58:41 pierre
  3354. * avoid Search sometimes disabled for Editor Windows
  3355. Revision 1.54 2000/01/10 14:59:50 pierre
  3356. * TProgramInfo was not registered
  3357. Revision 1.53 2000/01/07 14:02:52 pierre
  3358. + date string added
  3359. Revision 1.52 2000/01/03 11:38:34 michael
  3360. Changes from Gabor
  3361. Revision 1.51 1999/12/20 14:23:17 pierre
  3362. * MyApp renamed IDEApp
  3363. * TDebugController.ResetDebuggerRows added to
  3364. get resetting of debugger rows
  3365. Revision 1.50 1999/12/16 16:55:52 pierre
  3366. * fix of web bug 756
  3367. Revision 1.49 1999/11/25 00:25:43 pierre
  3368. * add Status when loading/saving files
  3369. Revision 1.48 1999/11/22 16:02:12 pierre
  3370. * TryToOpenFile failed tofind a sourcewindow if it has no number
  3371. Revision 1.47 1999/11/18 13:39:24 pierre
  3372. * Better info for Undo debugging
  3373. Revision 1.46 1999/11/10 00:44:12 pierre
  3374. * Grouped Undo action signaled in 'Dump Undo'
  3375. Revision 1.45 1999/10/29 14:50:07 pierre
  3376. * About dialog changes
  3377. Revision 1.44 1999/10/27 12:10:42 pierre
  3378. + With DebugUndo added 3 menu items
  3379. "Dump Undo" "Undo All" and "Redo All"
  3380. for Undo checks
  3381. Revision 1.43 1999/10/25 16:55:13 pierre
  3382. * adapted to a small weditor change
  3383. Revision 1.42 1999/09/16 14:34:59 pierre
  3384. + TBreakpoint and TWatch registering
  3385. + WatchesCollection and BreakpointsCollection stored in desk file
  3386. * Syntax highlighting was broken
  3387. Revision 1.41 1999/09/13 16:24:43 peter
  3388. + clock
  3389. * backspace unident like tp7
  3390. Revision 1.40 1999/09/09 16:30:37 pierre
  3391. * ModuleNames was not created in TMessageListBox.Load
  3392. Revision 1.39 1999/09/03 12:54:07 pierre
  3393. * adapted to modified tokens unit
  3394. * TryToOpen works better
  3395. Revision 1.38 1999/08/31 16:18:33 pierre
  3396. + TGDBWindow.Load and Store + Registration
  3397. Revision 1.37 1999/08/16 18:25:26 peter
  3398. * Adjusting the selection when the editor didn't contain any line.
  3399. * Reserved word recognition redesigned, but this didn't affect the overall
  3400. syntax highlight speed remarkably (at least not on my Amd-K6/350).
  3401. The syntax scanner loop is a bit slow but the main problem is the
  3402. recognition of special symbols. Switching off symbol processing boosts
  3403. the performance up to ca. 200%...
  3404. * The editor didn't allow copying (for ex to clipboard) of a single character
  3405. * 'File|Save as' caused permanently run-time error 3. Not any more now...
  3406. * Compiler Messages window (actually the whole desktop) did not act on any
  3407. keypress when compilation failed and thus the window remained visible
  3408. + Message windows are now closed upon pressing Esc
  3409. + At 'Run' the IDE checks whether any sources are modified, and recompiles
  3410. only when neccessary
  3411. + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
  3412. + LineSelect (Ctrl+K+L) implemented
  3413. * The IDE had problems closing help windows before saving the desktop
  3414. Revision 1.36 1999/08/03 20:22:39 peter
  3415. + TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
  3416. + Desktop saving should work now
  3417. - History saved
  3418. - Clipboard content saved
  3419. - Desktop saved
  3420. - Symbol info saved
  3421. * syntax-highlight bug fixed, which compared special keywords case sensitive
  3422. (for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
  3423. * with 'whole words only' set, the editor didn't found occourences of the
  3424. searched text, if the text appeared previously in the same line, but didn't
  3425. satisfied the 'whole-word' condition
  3426. * ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
  3427. (ie. the beginning of the selection)
  3428. * when started typing in a new line, but not at the start (X=0) of it,
  3429. the editor inserted the text one character more to left as it should...
  3430. * TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
  3431. * Shift shouldn't cause so much trouble in TCodeEditor now...
  3432. * Syntax highlight had problems recognizing a special symbol if it was
  3433. prefixed by another symbol character in the source text
  3434. * Auto-save also occours at Dos shell, Tool execution, etc. now...
  3435. Revision 1.35 1999/07/12 13:14:22 pierre
  3436. * LineEnd bug corrected, now goes end of text even if selected
  3437. + Until Return for debugger
  3438. + Code for Quit inside GDB Window
  3439. Revision 1.34 1999/06/30 23:58:20 pierre
  3440. + BreakpointsList Window implemented
  3441. with Edit/New/Delete functions
  3442. + Individual breakpoint dialog with support for all types
  3443. ignorecount and conditions
  3444. (commands are not yet implemented, don't know if this wolud be useful)
  3445. awatch and rwatch have problems because GDB does not annotate them
  3446. I fixed v4.16 for this
  3447. Revision 1.33 1999/06/28 19:32:28 peter
  3448. * fixes from gabor
  3449. Revision 1.32 1999/06/21 23:37:08 pierre
  3450. * VESASetVideoModeProc return value was not set
  3451. Revision 1.31 1999/06/02 11:19:13 pierre
  3452. * @ is now required for FPC for procedure address passing in functions
  3453. Revision 1.30 1999/05/22 13:44:33 peter
  3454. * fixed couple of bugs
  3455. Revision 1.29 1999/04/15 08:58:08 peter
  3456. * syntax highlight fixes
  3457. * browser updates
  3458. Revision 1.28 1999/04/07 21:55:56 peter
  3459. + object support for browser
  3460. * html help fixes
  3461. * more desktop saving things
  3462. * NODEBUG directive to exclude debugger
  3463. Revision 1.27 1999/04/01 10:27:06 pierre
  3464. + file(line) in start of message added
  3465. Revision 1.26 1999/03/23 16:16:41 peter
  3466. * linux fixes
  3467. Revision 1.25 1999/03/23 15:11:37 peter
  3468. * desktop saving things
  3469. * vesa mode
  3470. * preferences dialog
  3471. Revision 1.24 1999/03/21 22:51:37 florian
  3472. + functional screen mode switching added
  3473. Revision 1.23 1999/03/19 16:04:33 peter
  3474. * new compiler dialog
  3475. Revision 1.22 1999/03/16 00:44:45 peter
  3476. * forgotten in last commit :(
  3477. Revision 1.21 1999/03/08 14:58:16 peter
  3478. + prompt with dialogs for tools
  3479. Revision 1.20 1999/03/01 15:42:08 peter
  3480. + Added dummy entries for functions not yet implemented
  3481. * MenuBar didn't update itself automatically on command-set changes
  3482. * Fixed Debugging/Profiling options dialog
  3483. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is set
  3484. * efBackSpaceUnindents works correctly
  3485. + 'Messages' window implemented
  3486. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  3487. + Added TP message-filter support (for ex. you can call GREP thru
  3488. GREP2MSG and view the result in the messages window - just like in TP)
  3489. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  3490. so topic search didn't work...
  3491. * In FPHELP.PAS there were still context-variables defined as word instead
  3492. of THelpCtx
  3493. * StdStatusKeys() was missing from the statusdef for help windows
  3494. + Topic-title for index-table can be specified when adding a HTML-files
  3495. Revision 1.19 1999/02/22 11:51:39 peter
  3496. * browser updates from gabor
  3497. Revision 1.18 1999/02/22 11:29:38 pierre
  3498. + added col info in MessageItem
  3499. + grep uses HighLightExts and should work for linux
  3500. Revision 1.17 1999/02/22 02:15:22 peter
  3501. + default extension for save in the editor
  3502. + Separate Text to Find for the grep dialog
  3503. * fixed redir crash with tp7
  3504. Revision 1.16 1999/02/19 18:43:49 peter
  3505. + open dialog supports mask list
  3506. Revision 1.15 1999/02/17 15:04:02 pierre
  3507. + file(line) added in TProgramInfo message list
  3508. Revision 1.14 1999/02/16 12:45:18 pierre
  3509. * GDBWindow size and grow corrected
  3510. Revision 1.13 1999/02/15 09:36:06 pierre
  3511. * // comment ends at end of line !
  3512. GDB window changed !
  3513. now all is in a normal text editor, but pressing
  3514. Enter key will send part of line before cursor to GDB !
  3515. Revision 1.12 1999/02/11 19:07:25 pierre
  3516. * GDBWindow redesigned :
  3517. normal editor apart from
  3518. that any kbEnter will send the line (for begin to cursor)
  3519. to GDB command !
  3520. GDBWindow opened in Debugger Menu
  3521. still buggy :
  3522. -echo should not be present if at end of text
  3523. -GDBWindow becomes First after each step (I don't know why !)
  3524. Revision 1.11 1999/02/11 13:08:39 pierre
  3525. + TGDBWindow : direct gdb input/output
  3526. Revision 1.10 1999/02/10 09:42:52 pierre
  3527. + DoneReservedWords to avoid memory leaks
  3528. * TMessageItem Module field was not disposed
  3529. Revision 1.9 1999/02/05 12:12:02 pierre
  3530. + SourceDir that stores directories for sources that the
  3531. compiler should not know about
  3532. Automatically asked for addition when a new file that
  3533. needed filedialog to be found is in an unknown directory
  3534. Stored and retrieved from INIFile
  3535. + Breakpoints conditions added to INIFile
  3536. * Breakpoints insterted and removed at debin and end of debug session
  3537. Revision 1.8 1999/02/04 17:45:23 pierre
  3538. + BrowserAtCursor started
  3539. * bug in TryToOpenFile removed
  3540. Revision 1.7 1999/02/04 13:32:11 pierre
  3541. * Several things added (I cannot commit them independently !)
  3542. + added TBreakpoint and TBreakpointCollection
  3543. + added cmResetDebugger,cmGrep,CmToggleBreakpoint
  3544. + Breakpoint list in INIFile
  3545. * Select items now also depend of SwitchMode
  3546. * Reading of option '-g' was not possible !
  3547. + added search for -Fu args pathes in TryToOpen
  3548. + added code for automatic opening of FileDialog
  3549. if source not found
  3550. Revision 1.6 1999/01/21 11:54:27 peter
  3551. + tools menu
  3552. + speedsearch in symbolbrowser
  3553. * working run command
  3554. Revision 1.5 1999/01/14 21:42:25 peter
  3555. * source tracking from Gabor
  3556. Revision 1.4 1999/01/12 14:29:42 peter
  3557. + Implemented still missing 'switch' entries in Options menu
  3558. + Pressing Ctrl-B sets ASCII mode in editor, after which keypresses (even
  3559. ones with ASCII < 32 ; entered with Alt+<###>) are interpreted always as
  3560. ASCII chars and inserted directly in the text.
  3561. + Added symbol browser
  3562. * splitted fp.pas to fpide.pas
  3563. Revision 1.3 1999/01/04 11:49:53 peter
  3564. * 'Use tab characters' now works correctly
  3565. + Syntax highlight now acts on File|Save As...
  3566. + Added a new class to syntax highlight: 'hex numbers'.
  3567. * There was something very wrong with the palette managment. Now fixed.
  3568. + Added output directory (-FE<xxx>) support to 'Directories' dialog...
  3569. * Fixed some possible bugs in Running/Compiling, and the compilation/run
  3570. process revised
  3571. Revision 1.2 1998/12/28 15:47:54 peter
  3572. + Added user screen support, display & window
  3573. + Implemented Editor,Mouse Options dialog
  3574. + Added location of .INI and .CFG file
  3575. + Option (INI) file managment implemented (see bottom of Options Menu)
  3576. + Switches updated
  3577. + Run program
  3578. Revision 1.4 1998/12/22 10:39:53 peter
  3579. + options are now written/read
  3580. + find and replace routines
  3581. }