weditor.pas 161 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998 by Berczi Gabor
  5. Code editor template objects
  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. {$I globdir.inc}
  13. unit WEditor;
  14. interface
  15. {tes}
  16. uses
  17. Dos,Objects,Drivers,Views,Menus,Commands,
  18. WUtils;
  19. { try to only do syntax on part of file until current position
  20. does work correctly now ? at least I hope so PM }
  21. {$define TEST_PARTIAL_SYNTAX}
  22. { Please "change" this to a field in TCodeEditor and check for this it a normal
  23. "if"-construct in UpdateAttrs(). WEditor contains a _generic_ editor object
  24. and should stay as flexible as possible. - Gabor }
  25. const
  26. cmFileNameChanged = 51234;
  27. cmASCIIChar = 51235;
  28. cmClearLineHighlights = 51236;
  29. cmSaveCancelled = 51237;
  30. cmBreakLine = 51238;
  31. cmSelStart = 51239;
  32. cmSelEnd = 51240;
  33. cmLastCursorPos = 51241;
  34. cmIndentBlock = 51242;
  35. cmUnIndentBlock = 51243;
  36. cmSelectLine = 51244;
  37. cmWriteBlock = 51245;
  38. cmReadBlock = 51246;
  39. cmPrintBlock = 51247;
  40. cmResetDebuggerRow = 51248;
  41. cmAddChar = 51249;
  42. cmExpandCodeTemplate = 51250;
  43. EditorTextBufSize = {$ifdef FPC}32768{$else} 4096{$endif};
  44. MaxLineLength = {$ifdef FPC} 255{$else} 255{$endif};
  45. MaxLineCount = {$ifdef FPC}16380{$else}16380{$endif};
  46. CodeCompleteMinLen = 4; { minimum length of text to try to complete }
  47. efBackupFiles = $00000001;
  48. efInsertMode = $00000002;
  49. efAutoIndent = $00000004;
  50. efUseTabCharacters = $00000008;
  51. efBackSpaceUnindents = $00000010;
  52. efPersistentBlocks = $00000020;
  53. efSyntaxHighlight = $00000040;
  54. efBlockInsCursor = $00000080;
  55. efVerticalBlocks = $00000100;
  56. efHighlightColumn = $00000200;
  57. efHighlightRow = $00000400;
  58. efAutoBrackets = $00000800;
  59. efExpandAllTabs = $00001000;
  60. efKeepTrailingSpaces = $00002000;
  61. efCodeComplete = $00004000;
  62. efStoreContent = $80000000;
  63. attrAsm = 1;
  64. attrComment = 2;
  65. attrForceFull = 128;
  66. attrAll = attrAsm+attrComment;
  67. edOutOfMemory = 0;
  68. edReadError = 1;
  69. edWriteError = 2;
  70. edCreateError = 3;
  71. edSaveModify = 4;
  72. edSaveUntitled = 5;
  73. edSaveAs = 6;
  74. edFind = 7;
  75. edSearchFailed = 8;
  76. edReplace = 9;
  77. edReplacePrompt = 10;
  78. edTooManyLines = 11;
  79. edGotoLine = 12;
  80. edReplaceFile = 13;
  81. edWriteBlock = 14;
  82. edReadBlock = 15;
  83. edFileOnDiskChanged = 16;
  84. edChangedOnloading = 17;
  85. ffmOptions = $0007; ffsOptions = 0;
  86. ffmDirection = $0008; ffsDirection = 3;
  87. ffmScope = $0010; ffsScope = 4;
  88. ffmOrigin = $0020; ffsOrigin = 5;
  89. ffDoReplace = $0040;
  90. ffReplaceAll = $0080;
  91. ffCaseSensitive = $0001;
  92. ffWholeWordsOnly = $0002;
  93. ffPromptOnReplace = $0004;
  94. ffForward = $0000;
  95. ffBackward = $0008;
  96. ffGlobal = $0000;
  97. ffSelectedText = $0010;
  98. ffFromCursor = $0000;
  99. ffEntireScope = $0020;
  100. coTextColor = 0;
  101. coWhiteSpaceColor = 1;
  102. coCommentColor = 2;
  103. coReservedWordColor = 3;
  104. coIdentifierColor = 4;
  105. coStringColor = 5;
  106. coNumberColor = 6;
  107. coAssemblerColor = 7;
  108. coSymbolColor = 8;
  109. coDirectiveColor = 9;
  110. coHexNumberColor = 10;
  111. coTabColor = 11;
  112. coBreakColor = 12;
  113. coFirstColor = 0;
  114. coLastColor = coBreakColor;
  115. eaMoveCursor = 1;
  116. eaInsertLine = 2;
  117. eaInsertText = 3;
  118. eaDeleteLine = 4;
  119. eaDeleteText = 5;
  120. eaSelectionChanged = 6;
  121. eaCut = 7;
  122. eaPaste = 8;
  123. eaPasteWin = 9;
  124. eaClear = 10;
  125. LastAction = eaClear;
  126. ActionString : array [0..LastAction] of string[8] =
  127. ('','Move','InsLine','InsText','DelLine','DelText',
  128. 'SelCh','Cut','Paste','PasteWin','Clear');
  129. CIndicator = #2#3#1;
  130. CEditor = #33#34#35#36#37#38#39#40#41#42#43#44#45#46#47#48#49;
  131. TAB = #9;
  132. FindStrSize = 79;
  133. type
  134. PLine = ^TLine;
  135. TLine = record
  136. Text : PString;
  137. Format : PString;
  138. BeginsWithAsm,
  139. EndsWithAsm : boolean;
  140. IsBreakpoint : boolean;
  141. BeginsWithComment,
  142. EndsInSingleLineComment,
  143. EndsWithComment : boolean;
  144. BeginsWithDirective,
  145. EndsWithDirective : boolean;
  146. BeginCommentType,EndCommentType : byte;
  147. end;
  148. PLineCollection = ^TLineCollection;
  149. TLineCollection = object(TCollection)
  150. function At(Index: sw_Integer): PLine;
  151. procedure FreeItem(Item: Pointer); virtual;
  152. end;
  153. PIndicator = ^TIndicator;
  154. TIndicator = object(TView)
  155. Location: TPoint;
  156. Modified : Boolean;
  157. {$ifdef debug}
  158. StoreUndo : Boolean;
  159. SyntaxComplete : boolean;
  160. UseTabs : Boolean;
  161. {$endif debug}
  162. constructor Init(var Bounds: TRect);
  163. procedure Draw; virtual;
  164. function GetPalette: PPalette; virtual;
  165. procedure SetState(AState: Word; Enable: Boolean); virtual;
  166. procedure SetValue(ALocation: TPoint; AModified: Boolean);
  167. constructor Load(var S: TStream);
  168. procedure Store(var S: TStream);
  169. end;
  170. {$ifdef Undo}
  171. PEditorAction = ^TEditorAction;
  172. TEditorAction = object(TObject)
  173. StartPos : TPoint;
  174. EndPos : TPoint;
  175. Text : PString;
  176. ActionCount : longint;
  177. Action : byte;
  178. TimeStamp : longint; { this is needed to keep track of line number &
  179. position changes (for ex. for symbol browser)
  180. the line&pos references (eg. symbol info) should
  181. also contain such a timestamp. this will enable
  182. to determine which changes have been made since
  183. storage of the information and thus calculate
  184. the (probably) changed line & position information,
  185. so, we can still jump to the right position in the
  186. editor even when it is heavily modified - Gabor }
  187. constructor init(act:byte; StartP,EndP:TPoint;Txt:String);
  188. constructor init_group(act:byte);
  189. function is_grouped_action : boolean;
  190. destructor done; virtual;
  191. end;
  192. PEditorActionCollection = ^TEditorActionCollection;
  193. TEditorActionCollection = object(TCollection)
  194. CurrentGroupedAction : PEditorAction;
  195. function At(Idx : sw_integer) : PEditorAction;
  196. end;
  197. {$else}
  198. PEditorAction = ^TEditorAction;
  199. TEditorAction = packed record
  200. StartPos : TPoint;
  201. EndPos : TPoint;
  202. Text : PString;
  203. ActionCount : longint;
  204. Action : byte;
  205. TimeStamp : longint; { see above! }
  206. end;
  207. PEditorActionCollection = ^TEditorActionCollection;
  208. TEditorActionCollection = object(TCollection)
  209. function At(Idx : sw_integer) : PEditorAction;
  210. procedure FreeItem(Item: Pointer); virtual;
  211. end;
  212. {$endif Undo}
  213. TSpecSymbolClass =
  214. (ssCommentPrefix,ssCommentSingleLinePrefix,ssCommentSuffix,ssStringPrefix,ssStringSuffix,
  215. ssDirectivePrefix,ssDirectiveSuffix,ssAsmPrefix,ssAsmSuffix);
  216. TEditorBookMark = record
  217. Valid : boolean;
  218. Pos : TPoint;
  219. end;
  220. TCompleteState = (csInactive,csOffering,csDenied);
  221. PCodeEditor = ^TCodeEditor;
  222. TCodeEditor = object(TScroller)
  223. Indicator : PIndicator;
  224. Lines : PLineCollection;
  225. SelStart : TPoint;
  226. SelEnd : TPoint;
  227. Highlight : TRect;
  228. CurPos : TPoint;
  229. CanUndo : Boolean;
  230. StoreUndo : boolean;
  231. Modified : Boolean;
  232. IsReadOnly : Boolean;
  233. NoSelect : Boolean;
  234. Flags : longint;
  235. TabSize : integer;
  236. HighlightRow: sw_integer;
  237. DebuggerRow: sw_integer;
  238. UndoList : PEditorActionCollection;
  239. RedoList : PEditorActionCollection;
  240. CompleteState: TCompleteState;
  241. CodeCompleteFrag: PString;
  242. CodeCompleteWord: PString;
  243. AlwaysShowScrollBars: boolean;
  244. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  245. PScrollBar; AIndicator: PIndicator; AbufSize:Sw_Word);
  246. procedure SetFlags(AFlags: longint); virtual;
  247. procedure ConvertEvent(var Event: TEvent); virtual;
  248. procedure HandleEvent(var Event: TEvent); virtual;
  249. procedure SetState(AState: Word; Enable: Boolean); virtual;
  250. procedure LocalMenu(P: TPoint); virtual;
  251. function GetLocalMenu: PMenu; virtual;
  252. function GetCommandTarget: PView; virtual;
  253. function CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup; virtual;
  254. procedure Draw; virtual;
  255. procedure DrawCursor; virtual;
  256. procedure TrackCursor(Center: boolean); virtual;
  257. procedure UpdateIndicator; virtual;
  258. procedure LimitsChanged; virtual;
  259. procedure SelectionChanged; virtual;
  260. procedure HighlightChanged; virtual;
  261. procedure ModifiedChanged; virtual;
  262. procedure Update; virtual;
  263. procedure ScrollTo(X, Y: sw_Integer);
  264. procedure SetModified(AModified: boolean); virtual;
  265. procedure SetInsertMode(InsertMode: boolean); virtual;
  266. procedure SetCurPtr(X,Y: sw_integer); virtual;
  267. procedure SetSelection(A, B: TPoint); virtual;
  268. procedure SetHighlight(A, B: TPoint); virtual;
  269. procedure SetHighlightRow(Row: sw_integer); virtual;
  270. procedure SetDebuggerRow(Row: sw_integer); virtual;
  271. procedure SetCompleteState(AState: TCompleteState); virtual;
  272. function GetCodeCompleteFrag: string;
  273. procedure SetCodeCompleteFrag(const S: string);
  274. procedure SelectAll(Enable: boolean); virtual;
  275. function InsertFrom(Editor: PCodeEditor): Boolean; virtual;
  276. function InsertText(const S: string): Boolean; virtual;
  277. function GetPalette: PPalette; virtual;
  278. function IsClipboard: Boolean;
  279. constructor Load(var S: TStream);
  280. procedure Store(var S: TStream);
  281. function LoadFromStream(Stream: PStream): boolean; virtual;
  282. function SaveToStream(Stream: PStream): boolean; virtual;
  283. function SaveAreaToStream(Stream: PStream; StartP,EndP: TPoint): boolean;
  284. destructor Done; virtual;
  285. public
  286. { Text & info storage abstraction }
  287. function GetLineCount: sw_integer; virtual;
  288. function CharIdxToLinePos(Line,CharIdx: sw_integer): sw_integer;
  289. function LinePosToCharIdx(Line,X: sw_integer): sw_integer;
  290. function GetLineText(I: sw_integer): string; virtual;
  291. procedure SetDisplayText(I: sw_integer;const S: string); virtual;
  292. function GetDisplayText(I: sw_integer): string; virtual;
  293. procedure SetLineText(I: sw_integer;const S: string); virtual;
  294. procedure SetLineBreakState(I : sw_integer;b : boolean);
  295. procedure GetDisplayTextFormat(I: sw_integer;var DT,DF:string); virtual;
  296. function GetLineFormat(I: sw_integer): string; virtual;
  297. procedure SetLineFormat(I: sw_integer;const S: string); virtual;
  298. procedure DeleteAllLines; virtual;
  299. procedure DeleteLine(I: sw_integer); virtual;
  300. procedure AddLine(const S: string); virtual;
  301. function GetErrorMessage: string; virtual;
  302. procedure SetErrorMessage(const S: string); virtual;
  303. procedure AdjustSelection(DeltaX, DeltaY: sw_integer);
  304. procedure AdjustSelectionPos(CurPosX, CurPosY: sw_integer; DeltaX, DeltaY: sw_integer);
  305. function IsFlagSet(AFlag: longint): boolean;
  306. procedure GetContent(ALines: PUnsortedStringCollection); virtual;
  307. procedure SetContent(ALines: PUnsortedStringCollection); virtual;
  308. procedure Lock;
  309. procedure UnLock;
  310. private
  311. LastLocalCmd: word;
  312. KeyState : Integer;
  313. {$ifdef TEST_PARTIAL_SYNTAX}
  314. LastSyntaxedLine : sw_integer;
  315. SyntaxComplete : boolean;
  316. {$endif TEST_PARTIAL_SYNTAX}
  317. ChangedLine : sw_integer;
  318. ErrorMessage: PString;
  319. Bookmarks : array[0..9] of TEditorBookmark;
  320. LockFlag : integer;
  321. DrawCalled,
  322. DrawCursorCalled,
  323. IndicatorDrawCalled : boolean;
  324. CurEvent : PEvent;
  325. function Overwrite: boolean;
  326. function IsModal: boolean;
  327. function GetLine(I: sw_integer): PLine;
  328. procedure CheckSels;
  329. procedure CodeCompleteCheck;
  330. procedure CodeCompleteApply;
  331. procedure CodeCompleteCancel;
  332. procedure UpdateUndoRedo(cm : word; action : byte);
  333. function UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer;
  334. function UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer;
  335. procedure DrawLines(FirstLine: sw_integer);
  336. procedure HideHighlight;
  337. procedure AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: string);
  338. procedure AddGroupedAction(AAction : byte);
  339. procedure CloseGroupedAction(AAction : byte);
  340. function ShouldExtend: boolean;
  341. function ValidBlock: boolean;
  342. public
  343. { Syntax highlight support }
  344. function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
  345. function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
  346. function IsReservedWord(const S: string): boolean; virtual;
  347. { CodeTemplate support }
  348. function TranslateCodeTemplate(const Shortcut: string; ALines: PUnsortedStringCollection): boolean; virtual;
  349. { CodeComplete support }
  350. function CompleteCodeWord(const WordS: string; var Text: string): boolean; virtual;
  351. function GetCodeCompleteWord: string;
  352. procedure SetCodeCompleteWord(const S: string); virtual;
  353. procedure ClearCodeCompleteWord; virtual;
  354. public
  355. SearchRunCount: integer;
  356. InASCIIMode: boolean;
  357. procedure Indent; virtual;
  358. procedure CharLeft; virtual;
  359. procedure CharRight; virtual;
  360. procedure WordLeft; virtual;
  361. procedure WordRight; virtual;
  362. procedure LineStart; virtual;
  363. procedure LineEnd; virtual;
  364. procedure LineUp; virtual;
  365. procedure LineDown; virtual;
  366. procedure PageUp; virtual;
  367. procedure PageDown; virtual;
  368. procedure TextStart; virtual;
  369. procedure TextEnd; virtual;
  370. procedure JumpSelStart; virtual;
  371. procedure JumpSelEnd; virtual;
  372. procedure JumpMark(MarkIdx: integer); virtual;
  373. procedure DefineMark(MarkIdx: integer); virtual;
  374. procedure JumpToLastCursorPos; virtual;
  375. function InsertLine: Sw_integer; virtual;
  376. procedure BreakLine; virtual;
  377. procedure BackSpace; virtual;
  378. procedure DelChar; virtual;
  379. procedure DelWord; virtual;
  380. procedure DelStart; virtual;
  381. procedure DelEnd; virtual;
  382. procedure DelLine; virtual;
  383. procedure InsMode; virtual;
  384. procedure StartSelect; virtual;
  385. procedure EndSelect; virtual;
  386. procedure DelSelect; virtual;
  387. procedure HideSelect; virtual;
  388. procedure CopyBlock; virtual;
  389. procedure MoveBlock; virtual;
  390. procedure IndentBlock; virtual;
  391. procedure UnindentBlock; virtual;
  392. procedure SelectWord; virtual;
  393. procedure SelectLine; virtual;
  394. procedure WriteBlock; virtual;
  395. procedure ReadBlock; virtual;
  396. procedure PrintBlock; virtual;
  397. procedure ExpandCodeTemplate; virtual;
  398. procedure AddChar(C: char); virtual;
  399. {$ifdef WinClipSupported}
  400. function ClipCopyWin: Boolean; virtual;
  401. function ClipPasteWin: Boolean; virtual;
  402. {$endif WinClipSupported}
  403. function ClipCopy: Boolean; virtual;
  404. procedure ClipCut; virtual;
  405. procedure ClipPaste; virtual;
  406. function GetCurrentWord : string;
  407. procedure Undo; virtual;
  408. procedure Redo; virtual;
  409. procedure Find; virtual;
  410. procedure Replace; virtual;
  411. procedure DoSearchReplace; virtual;
  412. procedure GotoLine; virtual;
  413. end;
  414. PFileEditor = ^TFileEditor;
  415. TFileEditor = object(TCodeEditor)
  416. FileName: string;
  417. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  418. PScrollBar; AIndicator: PIndicator;const AFileName: string);
  419. function Save: Boolean; virtual;
  420. function SaveAs: Boolean; virtual;
  421. function SaveAsk: Boolean; virtual;
  422. function LoadFile: boolean; virtual;
  423. function SaveFile: boolean; virtual;
  424. function Valid(Command: Word): Boolean; virtual;
  425. procedure HandleEvent(var Event: TEvent); virtual;
  426. function ShouldSave: boolean; virtual;
  427. constructor Load(var S: TStream);
  428. procedure Store(var S: TStream);
  429. function IsChangedOnDisk : boolean;
  430. private
  431. OnDiskLoadTime : longint;
  432. end;
  433. TCodeEditorDialog = function(Dialog: Integer; Info: Pointer): Word;
  434. function DefUseSyntaxHighlight(Editor: PFileEditor): boolean;
  435. function DefUseTabsPattern(Editor: PFileEditor): boolean;
  436. const
  437. DefaultCodeEditorFlags : longint =
  438. efBackupFiles+efInsertMode+efAutoIndent+efPersistentBlocks+
  439. {efUseTabCharacters+}efBackSpaceUnindents+efSyntaxHighlight+
  440. efExpandAllTabs+efCodeComplete;
  441. DefaultTabSize : integer = 8;
  442. EOL : String[2] = {$ifdef Linux}#10;{$else}#13#10;{$endif}
  443. cmCopyWin = 240;
  444. cmPasteWin = 241;
  445. { History ID }
  446. FileId = 101;
  447. TextFindId = 105;
  448. TextReplaceID = 106;
  449. GotoID = 107;
  450. TextGrepId = 108;
  451. { used for ShiftDel and ShiftIns to avoid
  452. GetShiftState to be considered for extending
  453. selection (PM) }
  454. DontConsiderShiftState: boolean = false;
  455. ToClipCmds : TCommandSet = ([cmCut,cmCopy,cmCopyWin]);
  456. FromClipCmds : TCommandSet = ([cmPaste]);
  457. FromWinClipCmds : TCommandSet = ([cmPasteWin]);
  458. NulClipCmds : TCommandSet = ([cmClear]);
  459. UndoCmd : TCommandSet = ([cmUndo]);
  460. RedoCmd : TCommandSet = ([cmRedo]);
  461. function StdEditorDialog(Dialog: Integer; Info: Pointer): word;
  462. const
  463. EditorDialog : TCodeEditorDialog = StdEditorDialog;
  464. Clipboard : PCodeEditor = nil;
  465. FindStr : String[FindStrSize] = '';
  466. ReplaceStr : String[FindStrSize] = '';
  467. FindFlags : word = ffPromptOnReplace;
  468. WhiteSpaceChars : set of char = [#0,#32,#255];
  469. TabChars : set of char = [#9];
  470. HashChars : set of char = ['#'];
  471. AlphaChars : set of char = ['A'..'Z','a'..'z','_'];
  472. NumberChars : set of char = ['0'..'9'];
  473. RealNumberChars : set of char = ['E','e','.'{,'+','-'}];
  474. DefaultSaveExt : string[12] = '.pas';
  475. FileDir : DirStr = '';
  476. UseSyntaxHighlight : function(Editor: PFileEditor): boolean = DefUseSyntaxHighlight;
  477. UseTabsPattern : function(Editor: PFileEditor): boolean = DefUseTabsPattern;
  478. procedure RegisterCodeEditors;
  479. implementation
  480. uses
  481. MsgBox,Dialogs,App,StdDlg,HistList,Validate,
  482. {$ifdef WinClipSupported}
  483. Strings,WinClip,
  484. {$endif WinClipSupported}
  485. WViews;
  486. {$ifndef NOOBJREG}
  487. const
  488. RIndicator: TStreamRec = (
  489. ObjType: 1100;
  490. VmtLink: Ofs(TypeOf(TIndicator)^);
  491. Load: @TIndicator.Load;
  492. Store: @TIndicator.Store
  493. );
  494. RCodeEditor: TStreamRec = (
  495. ObjType: 1101;
  496. VmtLink: Ofs(TypeOf(TCodeEditor)^);
  497. Load: @TCodeEditor.Load;
  498. Store: @TCodeEditor.Store
  499. );
  500. RFileEditor: TStreamRec = (
  501. ObjType: 1102;
  502. VmtLink: Ofs(TypeOf(TFileEditor)^);
  503. Load: @TFileEditor.Load;
  504. Store: @TFileEditor.Store
  505. );
  506. {$endif}
  507. type
  508. TFindDialogRec = packed record
  509. Find : String[FindStrSize];
  510. Options : Word{longint};
  511. { checkboxes need 32 bits PM }
  512. { reverted to word in dialogs.TCluster for TP compatibility (PM) }
  513. { anyhow its complete nonsense : you can only have 16 fields
  514. but use a longint to store it !! }
  515. Direction: word;{ and tcluster has word size }
  516. Scope : word;
  517. Origin : word;
  518. end;
  519. TReplaceDialogRec = packed record
  520. Find : String[FindStrSize];
  521. Replace : String[FindStrSize];
  522. Options : Word{longint};
  523. Direction: word;
  524. Scope : word;
  525. Origin : word;
  526. end;
  527. TGotoLineDialogRec = packed record
  528. LineNo : string[5];
  529. Lines : sw_integer;
  530. end;
  531. const
  532. kbShift = kbLeftShift+kbRightShift;
  533. const
  534. FirstKeyCount = 40;
  535. FirstKeys: array[0..FirstKeyCount * 2] of Word = (FirstKeyCount,
  536. Ord(^A), cmWordLeft, Ord(^B), cmJumpLine, Ord(^C), cmPageDown,
  537. Ord(^D), cmCharRight, Ord(^E), cmLineUp,
  538. Ord(^F), cmWordRight, Ord(^G), cmDelChar,
  539. Ord(^H), cmBackSpace, Ord(^J), cmExpandCodeTemplate,
  540. Ord(^K), $FF02, Ord(^L), cmSearchAgain,
  541. Ord(^M), cmNewLine, Ord(^N), cmBreakLine,
  542. Ord(^P), cmASCIIChar, Ord(^Q), $FF01,
  543. Ord(^R), cmPageUp, Ord(^S), cmCharLeft,
  544. Ord(^T), cmDelWord, Ord(^U), cmUndo,
  545. Ord(^V), cmInsMode, Ord(^X), cmLineDown,
  546. Ord(^Y), cmDelLine, kbLeft, cmCharLeft,
  547. kbRight, cmCharRight, kbCtrlLeft, cmWordLeft,
  548. kbCtrlRight, cmWordRight, kbHome, cmLineStart,
  549. kbEnd, cmLineEnd, kbUp, cmLineUp,
  550. kbDown, cmLineDown, kbPgUp, cmPageUp,
  551. kbPgDn, cmPageDown, kbCtrlPgUp, cmTextStart,
  552. kbCtrlPgDn, cmTextEnd, kbIns, cmInsMode,
  553. kbDel, cmDelChar, kbShiftIns, cmPaste,
  554. kbShiftDel, cmCut, kbCtrlIns, cmCopy,
  555. kbCtrlDel, cmClear);
  556. QuickKeyCount = 23;
  557. QuickKeys: array[0..QuickKeyCount * 2] of Word = (QuickKeyCount,
  558. Ord('A'), cmReplace, Ord('C'), cmTextEnd,
  559. Ord('D'), cmLineEnd, Ord('F'), cmFind,
  560. Ord('H'), cmDelStart, Ord('R'), cmTextStart,
  561. Ord('S'), cmLineStart, Ord('Y'), cmDelEnd,
  562. Ord('G'), cmJumpLine, Ord('A'), cmReplace,
  563. Ord('B'), cmSelStart, Ord('K'), cmSelEnd,
  564. Ord('P'), cmLastCursorPos,
  565. Ord('0'), cmJumpMark0, Ord('1'), cmJumpMark1, Ord('2'), cmJumpMark2,
  566. Ord('3'), cmJumpMark3, Ord('4'), cmJumpMark4, Ord('5'), cmJumpMark5,
  567. Ord('6'), cmJumpMark6, Ord('7'), cmJumpMark7, Ord('8'), cmJumpMark8,
  568. Ord('9'), cmJumpMark9);
  569. BlockKeyCount = 23;
  570. BlockKeys: array[0..BlockKeyCount * 2] of Word = (BlockKeyCount,
  571. Ord('B'), cmStartSelect, Ord('C'), cmCopyBlock,
  572. Ord('H'), cmHideSelect, Ord('K'), cmEndSelect,
  573. Ord('Y'), cmDelSelect, Ord('V'), cmMoveBlock,
  574. Ord('I'), cmIndentBlock, Ord('U'), cmUnindentBlock,
  575. Ord('T'), cmSelectWord, Ord('L'), cmSelectLine,
  576. Ord('W'), cmWriteBlock, Ord('R'), cmReadBlock,
  577. Ord('P'), cmPrintBlock,
  578. Ord('0'), cmSetMark0, Ord('1'), cmSetMark1, Ord('2'), cmSetMark2,
  579. Ord('3'), cmSetMark3, Ord('4'), cmSetMark4, Ord('5'), cmSetMark5,
  580. Ord('6'), cmSetMark6, Ord('7'), cmSetMark7, Ord('8'), cmSetMark8,
  581. Ord('9'), cmSetMark9);
  582. KeyMap: array[0..2] of Pointer = (@FirstKeys, @QuickKeys, @BlockKeys);
  583. function ScanKeyMap(KeyMap: Pointer; KeyCode: Word): Word;
  584. type
  585. pword = ^word;
  586. var
  587. p : pword;
  588. count : sw_word;
  589. begin
  590. p:=keymap;
  591. count:=p^;
  592. inc(p);
  593. while (count>0) do
  594. begin
  595. if (lo(p^)=lo(keycode)) and
  596. ((hi(p^)=0) or (hi(p^)=hi(keycode))) then
  597. begin
  598. inc(p);
  599. scankeymap:=p^;
  600. Exit;
  601. end;
  602. inc(p,2);
  603. dec(count);
  604. end;
  605. scankeymap:=0;
  606. end;
  607. function IsWordSeparator(C: char): boolean;
  608. begin
  609. IsWordSeparator:=C in[' ',#0,#255,':','=','''','"','.',',','/',';','$','#','(',')','<','>','^','*','+','-','?','&'];
  610. end;
  611. function IsSpace(C: char): boolean;
  612. begin
  613. IsSpace:=C in[' ',#0,#255];
  614. end;
  615. function LTrim(S: string): string;
  616. begin
  617. while (length(S)>0) and (S[1] in [#0,TAB,#32]) do
  618. Delete(S,1,1);
  619. LTrim:=S;
  620. end;
  621. { TAB are not same as spaces if UseTabs is set PM }
  622. function RTrim(S: string;cut_tabs : boolean): string;
  623. begin
  624. while (length(S)>0) and
  625. ((S[length(S)] in [#0,#32]) or
  626. ((S[Length(S)]=TAB) and cut_tabs)) do
  627. Delete(S,length(S),1);
  628. RTrim:=S;
  629. end;
  630. function Trim(S: string): string;
  631. begin
  632. Trim:=RTrim(LTrim(S),true);
  633. end;
  634. function EatIO: integer;
  635. begin
  636. EatIO:=IOResult;
  637. end;
  638. function ExistsFile(const FileName: string): boolean;
  639. var f: file;
  640. Exists: boolean;
  641. begin
  642. if FileName='' then Exists:=false else
  643. begin
  644. {$I-}
  645. Assign(f,FileName);
  646. Reset(f,1);
  647. Exists:=EatIO=0;
  648. Close(f);
  649. EatIO;
  650. {$I+}
  651. end;
  652. ExistsFile:=Exists;
  653. end;
  654. function Max(A,B: longint): longint;
  655. begin
  656. if A>B then Max:=A else Max:=B;
  657. end;
  658. function Min(A,B: longint): longint;
  659. begin
  660. if A<B then Min:=A else Min:=B;
  661. end;
  662. function StrToInt(const S: string): longint;
  663. var L: longint;
  664. C: integer;
  665. begin
  666. Val(S,L,C); if C<>0 then L:=-1;
  667. StrToInt:=L;
  668. end;
  669. function RExpand(const S: string; MinLen: byte): string;
  670. begin
  671. if length(S)<MinLen then
  672. RExpand:=S+CharStr(' ',MinLen-length(S))
  673. else
  674. RExpand:=S;
  675. end;
  676. function upper(const s : string) : string;
  677. var
  678. i : Sw_word;
  679. begin
  680. for i:=1 to length(s) do
  681. if s[i] in ['a'..'z'] then
  682. upper[i]:=char(byte(s[i])-32)
  683. else
  684. upper[i]:=s[i];
  685. upper[0]:=s[0];
  686. end;
  687. function DirAndNameOf(const Path: string): string;
  688. var D: DirStr; N: NameStr; E: ExtStr;
  689. begin
  690. FSplit(Path,D,N,E);
  691. DirAndNameOf:=D+N;
  692. end;
  693. type TPosOfs = {$ifdef TP}longint{$endif}{$ifdef FPC}comp{$endif};
  694. function PosToOfs(const X,Y: sw_integer): TPosOfs;
  695. type TPosRec = record LoI, HiI: sw_integer; end;
  696. var C: TPosRec;
  697. begin
  698. C.LoI:=X; C.HiI:=Y;
  699. PosToOfs:=TPosOfs(C);
  700. end;
  701. function PosToOfsP(const P: TPoint): TPosOfs;
  702. begin
  703. PosToOfsP:=PosToOfs(P.X,P.Y);
  704. end;
  705. function PointOfs(P: TPoint): TPosOfs;
  706. begin
  707. PointOfs:={longint(P.Y)*MaxLineLength+P.X}PosToOfsP(P);
  708. end;
  709. {$ifndef Undo}
  710. function NewEditorAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: string): PEditorAction;
  711. var P: PEditorAction;
  712. begin
  713. New(P); FillChar(P^,SizeOf(P^),0);
  714. with P^ do
  715. begin
  716. Action:=AAction;
  717. StartPos:=AStartPos; EndPos:=AEndPos;
  718. Text:=NewStr(AText);
  719. end;
  720. NewEditorAction:=P;
  721. end;
  722. procedure DisposeEditorAction(P: PEditorAction);
  723. begin
  724. if P<>nil then
  725. begin
  726. if P^.Text<>nil then DisposeStr(P^.Text); P^.Text:=nil;
  727. Dispose(P);
  728. end;
  729. end;
  730. {$endif ndef Undo}
  731. function ExtractTabs(S: string; TabSize: Sw_integer): string;
  732. var
  733. P,PAdd: Sw_Word;
  734. begin
  735. p:=0;
  736. while p<length(s) do
  737. begin
  738. inc(p);
  739. if s[p]=TAB then
  740. begin
  741. PAdd:=TabSize-((p-1) mod TabSize);
  742. s:=copy(S,1,P-1)+CharStr(' ',PAdd)+copy(S,P+1,255);
  743. inc(P,PAdd-1);
  744. end;
  745. end;
  746. ExtractTabs:=S;
  747. end;
  748. function CompressUsingTabs(S: string; TabSize: byte): string;
  749. var TabS: string;
  750. P: byte;
  751. begin
  752. TabS:=CharStr(' ',TabSize);
  753. repeat
  754. P:=Pos(TabS,S);
  755. if P>0 then
  756. S:=copy(S,1,P-1)+TAB+copy(S,P+TabSize,255);
  757. until P=0;
  758. CompressUsingTabs:=S;
  759. end;
  760. {*****************************************************************************
  761. Forward/Backward Scanning
  762. *****************************************************************************}
  763. Const
  764. {$ifndef FPC}
  765. MaxBufLength = $7f00;
  766. NotFoundValue = -1;
  767. {$else}
  768. MaxBufLength = $7fffff00;
  769. NotFoundValue = -1;
  770. {$endif}
  771. Type
  772. Btable = Array[0..255] of Byte;
  773. Procedure BMFMakeTable(const s:string; Var t : Btable);
  774. Var
  775. x : sw_integer;
  776. begin
  777. FillChar(t,sizeof(t),length(s));
  778. For x := length(s) downto 1 do
  779. if (t[ord(s[x])] = length(s)) then
  780. t[ord(s[x])] := length(s) - x;
  781. end;
  782. function BMFScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
  783. Var
  784. buffer : Array[0..MaxBufLength-1] of Byte Absolute block;
  785. s2 : String;
  786. len,
  787. numb : Sw_Word;
  788. found : Boolean;
  789. begin
  790. len:=length(str);
  791. if len>size then
  792. begin
  793. BMFScan := NotFoundValue;
  794. exit;
  795. end;
  796. s2[0]:=chr(len); { sets the length to that of the search String }
  797. found:=False;
  798. numb:=pred(len);
  799. While (not found) and (numb<size) do
  800. begin
  801. { partial match }
  802. if buffer[numb] = ord(str[len]) then
  803. begin
  804. { less partial! }
  805. if buffer[numb-pred(len)] = ord(str[1]) then
  806. begin
  807. move(buffer[numb-pred(len)],s2[1],len);
  808. if (str=s2) then
  809. begin
  810. found:=true;
  811. break;
  812. end;
  813. end;
  814. inc(numb);
  815. end
  816. else
  817. inc(numb,Bt[buffer[numb]]);
  818. end;
  819. if not found then
  820. BMFScan := NotFoundValue
  821. else
  822. BMFScan := numb - pred(len);
  823. end;
  824. function BMFIScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
  825. Var
  826. buffer : Array[0..MaxBufLength-1] of Char Absolute block;
  827. len,
  828. numb,
  829. x : Sw_Word;
  830. found : Boolean;
  831. p : pchar;
  832. c : char;
  833. begin
  834. len:=length(str);
  835. if (len=0) or (len>size) then
  836. begin
  837. BMFIScan := NotFoundValue;
  838. exit;
  839. end;
  840. found:=False;
  841. numb:=pred(len);
  842. While (not found) and (numb<size) do
  843. begin
  844. { partial match }
  845. c:=buffer[numb];
  846. if c in ['a'..'z'] then
  847. c:=chr(ord(c)-32);
  848. if (c=str[len]) then
  849. begin
  850. { less partial! }
  851. p:=@buffer[numb-pred(len)];
  852. x:=1;
  853. while (x<=len) do
  854. begin
  855. if not(((p^ in ['a'..'z']) and (chr(ord(p^)-32)=str[x])) or
  856. (p^=str[x])) then
  857. break;
  858. inc(p);
  859. inc(x);
  860. end;
  861. if (x>len) then
  862. begin
  863. found:=true;
  864. break;
  865. end;
  866. inc(numb);
  867. end
  868. else
  869. inc(numb,Bt[ord(c)]);
  870. end;
  871. if not found then
  872. BMFIScan := NotFoundValue
  873. else
  874. BMFIScan := numb - pred(len);
  875. end;
  876. Procedure BMBMakeTable(const s:string; Var t : Btable);
  877. Var
  878. x : sw_integer;
  879. begin
  880. FillChar(t,sizeof(t),length(s));
  881. For x := 1 to length(s)do
  882. if (t[ord(s[x])] = length(s)) then
  883. t[ord(s[x])] := x-1;
  884. end;
  885. function BMBScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
  886. Var
  887. buffer : Array[0..MaxBufLength-1] of Byte Absolute block;
  888. s2 : String;
  889. len,
  890. numb : Sw_integer;
  891. found : Boolean;
  892. begin
  893. len:=length(str);
  894. if len>size then
  895. begin
  896. BMBScan := NotFoundValue;
  897. exit;
  898. end;
  899. s2[0]:=chr(len); { sets the length to that of the search String }
  900. found:=False;
  901. numb:=size-pred(len);
  902. While (not found) and (numb>0) do
  903. begin
  904. { partial match }
  905. if buffer[numb] = ord(str[1]) then
  906. begin
  907. { less partial! }
  908. if buffer[numb+pred(len)] = ord(str[len]) then
  909. begin
  910. move(buffer[numb],s2[1],len);
  911. if (str=s2) then
  912. begin
  913. found:=true;
  914. break;
  915. end;
  916. end;
  917. dec(numb);
  918. end
  919. else
  920. dec(numb,Bt[buffer[numb]]);
  921. end;
  922. if not found then
  923. BMBScan := NotFoundValue
  924. else
  925. BMBScan := numb;
  926. end;
  927. function BMBIScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
  928. Var
  929. buffer : Array[0..MaxBufLength-1] of Char Absolute block;
  930. len,
  931. numb,
  932. x : Sw_integer;
  933. found : Boolean;
  934. p : pchar;
  935. c : char;
  936. begin
  937. len:=length(str);
  938. if (len=0) or (len>size) then
  939. begin
  940. BMBIScan := NotFoundValue;
  941. exit;
  942. end;
  943. found:=False;
  944. numb:=size-len;
  945. While (not found) and (numb>0) do
  946. begin
  947. { partial match }
  948. c:=buffer[numb];
  949. if c in ['a'..'z'] then
  950. c:=chr(ord(c)-32);
  951. if (c=str[1]) then
  952. begin
  953. { less partial! }
  954. p:=@buffer[numb];
  955. x:=1;
  956. while (x<=len) do
  957. begin
  958. if not(((p^ in ['a'..'z']) and (chr(ord(p^)-32)=str[x])) or
  959. (p^=str[x])) then
  960. break;
  961. inc(p);
  962. inc(x);
  963. end;
  964. if (x>len) then
  965. begin
  966. found:=true;
  967. break;
  968. end;
  969. dec(numb);
  970. end
  971. else
  972. dec(numb,Bt[ord(c)]);
  973. end;
  974. if not found then
  975. BMBIScan := NotFoundValue
  976. else
  977. BMBIScan := numb;
  978. end;
  979. {*****************************************************************************
  980. PLine,TLineCollection
  981. *****************************************************************************}
  982. function NewLine(S: string): PLine;
  983. var P: PLine;
  984. begin
  985. New(P); FillChar(P^,SizeOf(P^),0);
  986. P^.Text:=NewStr(S);
  987. NewLine:=P;
  988. end;
  989. procedure DisposeLine(P: PLine);
  990. begin
  991. if P<>nil then
  992. begin
  993. if P^.Text<>nil then DisposeStr(P^.Text);
  994. if P^.Format<>nil then DisposeStr(P^.Format);
  995. Dispose(P);
  996. end;
  997. end;
  998. function TLineCollection.At(Index: sw_Integer): PLine;
  999. begin
  1000. At:=inherited At(Index);
  1001. end;
  1002. procedure TLineCollection.FreeItem(Item: Pointer);
  1003. begin
  1004. if Item<>nil then DisposeLine(Item);
  1005. end;
  1006. constructor TIndicator.Init(var Bounds: TRect);
  1007. begin
  1008. inherited Init(Bounds);
  1009. GrowMode := gfGrowLoY + gfGrowHiY;
  1010. end;
  1011. procedure TIndicator.Draw;
  1012. var
  1013. Color: Byte;
  1014. Frame: Char;
  1015. L: array[0..1] of Longint;
  1016. S: String[15];
  1017. B: TDrawBuffer;
  1018. begin
  1019. if (State and sfDragging = 0) and (State and sfActive <> 0) then
  1020. begin
  1021. Color := GetColor(1);
  1022. Frame := #205;
  1023. end
  1024. else
  1025. begin
  1026. if (State and sfDragging)<>0 then
  1027. Color := GetColor(2)
  1028. else
  1029. Color := GetColor(3);
  1030. Frame := #196;
  1031. end;
  1032. MoveChar(B, Frame, Color, Size.X);
  1033. if State and sfActive<>0 then
  1034. begin
  1035. if Modified then
  1036. WordRec (B[0]).Lo := ord('*');
  1037. {$ifdef debug}
  1038. if StoreUndo then
  1039. WordRec (B[1]).Lo := ord('S');
  1040. if SyntaxComplete then
  1041. WordRec(B[2]).lo := ord('C');
  1042. if UseTabs then
  1043. WordRec(B[3]).lo := ord('T');
  1044. {$endif debug}
  1045. L[0] := Location.Y + 1;
  1046. L[1] := Location.X + 1;
  1047. FormatStr(S, '%d:%d ', L);
  1048. MoveStr(B[8 - Pos(':', S)], S, Color);
  1049. end;
  1050. WriteBuf(0, 0, Size.X, 1, B);
  1051. end;
  1052. function TIndicator.GetPalette: PPalette;
  1053. const
  1054. P: string[Length(CIndicator)] = CIndicator;
  1055. begin
  1056. GetPalette := @P;
  1057. end;
  1058. procedure TIndicator.SetState(AState: Word; Enable: Boolean);
  1059. begin
  1060. inherited SetState(AState, Enable);
  1061. if (AState = sfDragging) or (AState=sfActive) then
  1062. DrawView;
  1063. end;
  1064. procedure TIndicator.SetValue(ALocation: TPoint; AModified: Boolean);
  1065. begin
  1066. if (Location.X<>ALocation.X) or
  1067. (Location.Y<>ALocation.Y) or
  1068. (Modified <> AModified) then
  1069. begin
  1070. Location := ALocation;
  1071. Modified := AModified;
  1072. DrawView;
  1073. end;
  1074. end;
  1075. constructor TIndicator.Load(var S: TStream);
  1076. begin
  1077. inherited Load(S);
  1078. S.Read(Location,SizeOf(Location));
  1079. S.Read(Modified,SizeOf(Modified));
  1080. end;
  1081. procedure TIndicator.Store(var S: TStream);
  1082. begin
  1083. inherited Store(S);
  1084. S.Write(Location,SizeOf(Location));
  1085. S.Write(Modified,SizeOf(Modified));
  1086. end;
  1087. {*****************************************************************************
  1088. TCodeEditor
  1089. *****************************************************************************}
  1090. constructor TCodeEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  1091. PScrollBar; AIndicator: PIndicator; ABufSize:Sw_Word);
  1092. begin
  1093. inherited Init(Bounds,AHScrollBar,AVScrollBar);
  1094. {$ifndef Undo}
  1095. StoreUndo:=false;
  1096. {$else Undo}
  1097. StoreUndo:=true;
  1098. {$endif def Undo}
  1099. new(UndoList,init(500,1000));
  1100. new(RedoList,init(500,1000));
  1101. New(Lines, Init(500,1000));
  1102. { we have always need at least 1 line }
  1103. Lines^.Insert(NewLine(''));
  1104. { ^^^ why? setlinetext() inserts automatically if neccessary and
  1105. getlinetext() checks whether you're in range...
  1106. because otherwise you search for line with index -1 (PM)
  1107. Then I think the algorithm should be changed to handle this special case,
  1108. instead of applying this "work-around" - Gabor
  1109. }
  1110. SetState(sfCursorVis,true);
  1111. SetFlags(DefaultCodeEditorFlags); TabSize:=DefaultTabSize;
  1112. SetHighlightRow(-1);
  1113. SetDebuggerRow(-1);
  1114. SetCurPtr(0,0);
  1115. Indicator:=AIndicator;
  1116. {$ifdef TEST_PARTIAL_SYNTAX}
  1117. SyntaxComplete:=true;
  1118. {$endif TEST_PARTIAL_SYNTAX}
  1119. UpdateIndicator;
  1120. LimitsChanged;
  1121. end;
  1122. procedure TCodeEditor.SetFlags(AFlags: longint);
  1123. var I: sw_integer;
  1124. OldFlags: longint;
  1125. begin
  1126. OldFlags:=Flags;
  1127. Flags:=AFlags;
  1128. if ((OldFlags xor Flags) and efCodeComplete)<>0 then
  1129. ClearCodeCompleteWord;
  1130. SetInsertMode(IsFlagSet(efInsertMode));
  1131. if IsFlagSet(efSyntaxHighlight) then
  1132. UpdateAttrs(0,attrAll) else
  1133. for I:=0 to GetLineCount-1 do
  1134. SetLineFormat(I,'');
  1135. UpdateIndicator;
  1136. DrawView;
  1137. end;
  1138. function TCodeEditor.GetErrorMessage: string;
  1139. var S: string;
  1140. begin
  1141. if ErrorMessage=nil then S:='' else S:=ErrorMessage^;
  1142. GetErrorMessage:=S;
  1143. end;
  1144. procedure TCodeEditor.SetErrorMessage(const S: string);
  1145. begin
  1146. if ErrorMessage<>nil then DisposeStr(ErrorMessage);
  1147. ErrorMessage:=NewStr(S);
  1148. DrawView;
  1149. end;
  1150. procedure TCodeEditor.GetContent(ALines: PUnsortedStringCollection);
  1151. procedure AddIt(P: PLine); {$ifndef FPC}far;{$endif}
  1152. begin
  1153. if Assigned(P) and Assigned(P^.Text) then
  1154. ALines^.Insert(NewStr(GetStr(P^.Text)));
  1155. end;
  1156. begin
  1157. if Assigned(Lines) then
  1158. Lines^.ForEach(@AddIt);
  1159. end;
  1160. procedure TCodeEditor.SetContent(ALines: PUnsortedStringCollection);
  1161. procedure AddIt(P: PString); {$ifndef FPC}far;{$endif}
  1162. begin
  1163. AddLine(GetStr(P));
  1164. end;
  1165. begin
  1166. Lock;
  1167. TextStart; HideSelect; DeleteAllLines;
  1168. if Assigned(ALines) then
  1169. ALines^.ForEach(@AddIt);
  1170. LimitsChanged;
  1171. if IsFlagSet(efSyntaxHighlight) then
  1172. UpdateAttrsRange(0,Min(Delta.Y+Size.Y,GetLineCount-1),
  1173. attrAll
  1174. {$ifndef TEST_PARTIAL_SYNTAX}
  1175. +attrForceFull
  1176. {$endif TEST_PARTIAL_SYNTAX}
  1177. );
  1178. TextStart;
  1179. UnLock;
  1180. end;
  1181. procedure TCodeEditor.Lock;
  1182. begin
  1183. Inc(LockFlag);
  1184. end;
  1185. procedure TCodeEditor.UnLock;
  1186. begin
  1187. {$ifdef DEBUG}
  1188. if lockflag=0 then
  1189. Bug('negative lockflag',nil)
  1190. else
  1191. {$endif DEBUG}
  1192. Dec(LockFlag);
  1193. if (LockFlag>0) then
  1194. exit;
  1195. if DrawCalled then
  1196. DrawView;
  1197. If IndicatorDrawCalled and
  1198. assigned(Indicator) then
  1199. begin
  1200. Indicator^.DrawView;
  1201. IndicatorDrawCalled:=false;
  1202. end;
  1203. If DrawCursorCalled then
  1204. Begin
  1205. DrawCursor;
  1206. DrawCursorCalled:=false;
  1207. End;
  1208. end;
  1209. procedure TCodeEditor.AdjustSelectionPos(CurPosX, CurPosY: sw_integer; DeltaX, DeltaY: sw_integer);
  1210. var CP: TPoint;
  1211. begin
  1212. if ValidBlock=false then Exit;
  1213. CP.X:=CurPosX; CP.Y:=CurPosY;
  1214. if (PosToOfsP(SelStart)<=PosToOfsP(CP)) and (PosToOfsP(CP)<PosToOfsP(SelEnd)) then
  1215. begin
  1216. { CurPos is IN selection }
  1217. Inc(SelEnd.Y,DeltaY);
  1218. if (CP.Y=SelEnd.Y) and
  1219. ((SelStart.Y<>SelEnd.Y) or (SelStart.X<=CP.X)) and
  1220. (CP.X<=SelEnd.X) then
  1221. Inc(SelEnd.X,DeltaX);
  1222. SelectionChanged;
  1223. end
  1224. else
  1225. if (PosToOfsP(CP)<=PosToOfsP(SelStart)) then
  1226. begin
  1227. { CurPos is BEFORE selection }
  1228. if (CP.Y=SelStart.Y) and (CP.Y=SelEnd.Y) and (DeltaY<0) then
  1229. begin
  1230. SelStart:=CurPos; SelEnd:=CurPos;
  1231. end
  1232. else
  1233. if (CP.Y=SelStart.Y) then
  1234. begin
  1235. if CP.X<SelStart.X then
  1236. Inc(SelStart.X,DeltaX);
  1237. end;
  1238. { else}
  1239. begin
  1240. Inc(SelStart.Y,DeltaY);
  1241. Inc(SelEnd.Y,DeltaY);
  1242. end;
  1243. if SelEnd.Y=CurPos.Y then Inc(SelEnd.X,DeltaX);
  1244. SelectionChanged;
  1245. end
  1246. else
  1247. begin
  1248. { CurPos is AFTER selection }
  1249. { actually we don't have to do anything here }
  1250. end;
  1251. end;
  1252. function TCodeEditor.IsFlagSet(AFlag: longint): boolean;
  1253. begin
  1254. IsFlagSet:=(Flags and AFlag)=AFlag;
  1255. end;
  1256. procedure TCodeEditor.AdjustSelection(DeltaX, DeltaY: sw_integer);
  1257. begin
  1258. AdjustSelectionPos(CurPos.X,CurPos.Y,DeltaX,DeltaY);
  1259. end;
  1260. procedure TCodeEditor.TrackCursor(Center: boolean);
  1261. var D: TPoint;
  1262. begin
  1263. D:=Delta;
  1264. if CurPos.Y<Delta.Y then D.Y:=CurPos.Y else
  1265. if CurPos.Y>Delta.Y+Size.Y-1 then D.Y:=CurPos.Y-Size.Y+1;
  1266. if CurPos.X<Delta.X then D.X:=CurPos.X else
  1267. if CurPos.X>Delta.X+Size.X-1 then D.X:=CurPos.X-Size.X+1;
  1268. if {((Delta.X<>D.X) or (Delta.Y<>D.Y)) and }Center then
  1269. begin
  1270. { loose centering for debugger PM }
  1271. while (CurPos.Y-D.Y)<(Size.Y div 3) do Dec(D.Y);
  1272. while (CurPos.Y-D.Y)>2*(Size.Y div 3) do Inc(D.Y);
  1273. end;
  1274. if (Delta.X<>D.X) or (Delta.Y<>D.Y) then
  1275. ScrollTo(D.X,D.Y);
  1276. DrawCursor;
  1277. UpdateIndicator;
  1278. end;
  1279. procedure TCodeEditor.ScrollTo(X, Y: sw_Integer);
  1280. begin
  1281. inherited ScrollTo(X,Y);
  1282. if (HScrollBar=nil) or (VScrollBar=nil) then
  1283. begin Delta.X:=X; Delta.Y:=Y; end;
  1284. DrawView;
  1285. end;
  1286. function TCodeEditor.IsModal: boolean;
  1287. var IsM: boolean;
  1288. begin
  1289. IsM:=GetState(sfModal);
  1290. if Assigned(Owner) then
  1291. IsM:=IsM or Owner^.GetState(sfModal);
  1292. IsModal:=IsM;
  1293. end;
  1294. procedure TCodeEditor.UpdateIndicator;
  1295. begin
  1296. if Indicator<>nil then
  1297. begin
  1298. Indicator^.Location:=CurPos;
  1299. Indicator^.Modified:=Modified;
  1300. {$ifdef debug}
  1301. Indicator^.StoreUndo:=StoreUndo;
  1302. {$ifdef TEST_PARTIAL_SYNTAX}
  1303. Indicator^.SyntaxComplete:=SyntaxComplete and IsFlagSet(efSyntaxHighlight);
  1304. {$endif TEST_PARTIAL_SYNTAX}
  1305. Indicator^.UseTabs:=IsFlagSet(efUseTabCharacters);
  1306. {$endif debug}
  1307. if lockflag>0 then
  1308. IndicatorDrawCalled:=true
  1309. else
  1310. Indicator^.DrawView;
  1311. end;
  1312. end;
  1313. procedure TCodeEditor.LimitsChanged;
  1314. begin
  1315. SetLimit(MaxLineLength+1,GetLineCount);
  1316. end;
  1317. procedure TCodeEditor.ConvertEvent(var Event: TEvent);
  1318. var
  1319. Key: Word;
  1320. begin
  1321. if Event.What = evKeyDown then
  1322. begin
  1323. if (Event.KeyShift and kbShift <> 0) and
  1324. (Event.ScanCode >= $47) and (Event.ScanCode <= $51) then
  1325. Event.CharCode := #0;
  1326. Key := Event.KeyCode;
  1327. if KeyState <> 0 then
  1328. begin
  1329. if (Lo(Key) >= $01) and (Lo(Key) <= $1A) then Inc(Key, $40);
  1330. if (Lo(Key) >= $61) and (Lo(Key) <= $7A) then Dec(Key, $20);
  1331. end;
  1332. Key := ScanKeyMap(KeyMap[KeyState], Key);
  1333. if (KeyState<>0) and (Key=0) then
  1334. ClearEvent(Event); { eat second key if unrecognized after ^Q or ^K }
  1335. KeyState := 0;
  1336. if Key <> 0 then
  1337. if Hi(Key) = $FF then
  1338. begin
  1339. KeyState := Lo(Key);
  1340. ClearEvent(Event);
  1341. end
  1342. else
  1343. begin
  1344. Event.What := evCommand;
  1345. Event.Command := Key;
  1346. end;
  1347. end;
  1348. end;
  1349. procedure TCodeEditor.HandleEvent(var Event: TEvent);
  1350. var DontClear : boolean;
  1351. procedure CheckScrollBar(P: PScrollBar; var D: Sw_Integer);
  1352. begin
  1353. if (Event.InfoPtr = P) and (P^.Value <> D) then
  1354. begin
  1355. D := P^.Value;
  1356. DrawView;
  1357. end;
  1358. end;
  1359. procedure GetMousePos(var P: TPoint);
  1360. begin
  1361. MakeLocal(Event.Where,P);
  1362. Inc(P.X,Delta.X); Inc(P.Y,Delta.Y);
  1363. end;
  1364. type TCCAction = (ccCheck,ccClear,ccDontCare);
  1365. var
  1366. StartP,P: TPoint;
  1367. E: TEvent;
  1368. OldEvent : PEvent;
  1369. CCAction: TCCAction;
  1370. begin
  1371. CCAction:=ccClear;
  1372. E:=Event;
  1373. OldEvent:=CurEvent;
  1374. if (E.What and (evMouse or evKeyboard))<>0 then
  1375. CurEvent:=@E;
  1376. if (InASCIIMode=false) or (Event.What<>evKeyDown) then
  1377. if (Event.What<>evKeyDown) or
  1378. ((Event.KeyCode<>kbEnter) and (Event.KeyCode<>kbEsc)) or
  1379. (CompleteState<>csOffering) then
  1380. ConvertEvent(Event);
  1381. case Event.What of
  1382. evMouseDown :
  1383. if MouseInView(Event.Where) then
  1384. if (Event.Buttons=mbRightButton) then
  1385. begin
  1386. MakeLocal(Event.Where,P); Inc(P.X); Inc(P.Y);
  1387. LocalMenu(P);
  1388. ClearEvent(Event);
  1389. end else
  1390. if Event.Buttons=mbLeftButton then
  1391. begin
  1392. GetMousePos(P);
  1393. StartP:=P;
  1394. SetCurPtr(P.X,P.Y);
  1395. repeat
  1396. GetMousePos(P);
  1397. if PointOfs(P)<PointOfs(StartP)
  1398. then SetSelection(P,StartP)
  1399. else SetSelection(StartP,P);
  1400. SetCurPtr(P.X,P.Y);
  1401. DrawView;
  1402. until not MouseEvent(Event, evMouseMove+evMouseAuto);
  1403. DrawView;
  1404. end;
  1405. evKeyDown :
  1406. begin
  1407. { Scancode is almost never zero PM }
  1408. { this is supposed to enable entering of ASCII chars below 32,
  1409. which are normally interpreted as control chars. So, when you enter
  1410. Alt+24 (on the numeric pad) then this will normally move the cursor
  1411. one line down, but if you do it in ASCII mode (also after Ctrl+B)
  1412. then this will insert the ASCII #24 char (upper arrow) in the
  1413. source code. - Gabor }
  1414. if InASCIIMode {and (Event.CharCode<>0)} then
  1415. begin
  1416. AddChar(Event.CharCode);
  1417. if (CompleteState<>csDenied) or (Event.CharCode=#32) then
  1418. CCAction:=ccCheck
  1419. else
  1420. CCAction:=ccClear;
  1421. end
  1422. else
  1423. begin
  1424. DontClear:=false;
  1425. case Event.KeyCode of
  1426. kbAltF10 :
  1427. Message(@Self,evCommand,cmLocalMenu,@Self);
  1428. kbEnter :
  1429. if CompleteState=csOffering then
  1430. CodeCompleteApply
  1431. else
  1432. Message(@Self,evCommand,cmNewLine,nil);
  1433. kbEsc :
  1434. if CompleteState=csOffering then
  1435. CodeCompleteCancel else
  1436. if IsModal then
  1437. DontClear:=true;
  1438. else
  1439. case Event.CharCode of
  1440. #9,#32..#255 :
  1441. if (Event.CharCode=#9) and IsModal then
  1442. DontClear:=true
  1443. else
  1444. begin
  1445. NoSelect:=true;
  1446. AddChar(Event.CharCode);
  1447. NoSelect:=false;
  1448. if (CompleteState<>csDenied) or (Event.CharCode=#32) then
  1449. CCAction:=ccCheck
  1450. else
  1451. CCAction:=ccClear;
  1452. end;
  1453. else
  1454. DontClear:=true;
  1455. end; { case Event.CharCode .. }
  1456. end; { case Event.KeyCode .. }
  1457. if not DontClear then
  1458. ClearEvent(Event);
  1459. end;
  1460. InASCIIMode:=false;
  1461. end;
  1462. evCommand :
  1463. begin
  1464. DontClear:=false;
  1465. case Event.Command of
  1466. cmASCIIChar : InASCIIMode:=not InASCIIMode;
  1467. cmAddChar : AddChar(chr(longint(Event.InfoPtr)));
  1468. cmCharLeft : CharLeft;
  1469. cmCharRight : CharRight;
  1470. cmWordLeft : WordLeft;
  1471. cmWordRight : WordRight;
  1472. cmLineStart : LineStart;
  1473. cmLineEnd : LineEnd;
  1474. cmLineUp : LineUp;
  1475. cmLineDown : LineDown;
  1476. cmPageUp : PageUp;
  1477. cmPageDown : PageDown;
  1478. cmTextStart : TextStart;
  1479. cmTextEnd : TextEnd;
  1480. cmNewLine : InsertLine;
  1481. cmBreakLine : BreakLine;
  1482. cmBackSpace : BackSpace;
  1483. cmDelChar : DelChar;
  1484. cmDelWord : DelWord;
  1485. cmDelStart : DelStart;
  1486. cmDelEnd : DelEnd;
  1487. cmDelLine : DelLine;
  1488. cmInsMode : InsMode;
  1489. cmStartSelect : StartSelect;
  1490. cmHideSelect : HideSelect;
  1491. cmUpdateTitle : ;
  1492. cmEndSelect : EndSelect;
  1493. cmDelSelect : DelSelect;
  1494. cmCopyBlock : CopyBlock;
  1495. cmMoveBlock : MoveBlock;
  1496. cmIndentBlock : IndentBlock;
  1497. cmUnindentBlock : UnindentBlock;
  1498. cmSelStart : JumpSelStart;
  1499. cmSelEnd : JumpSelEnd;
  1500. cmLastCursorPos : JumpToLastCursorPos;
  1501. cmJumpMark0..cmJumpMark9 : JumpMark(Event.Command-cmJumpMark0);
  1502. cmSetMark0..cmSetMark9 : DefineMark(Event.Command-cmSetMark0);
  1503. cmSelectWord : SelectWord;
  1504. cmSelectLine : SelectLine;
  1505. cmWriteBlock : WriteBlock;
  1506. cmReadBlock : ReadBlock;
  1507. cmPrintBlock : PrintBlock;
  1508. { ------ }
  1509. cmFind : Find;
  1510. cmReplace : Replace;
  1511. cmSearchAgain : DoSearchReplace;
  1512. cmJumpLine : GotoLine;
  1513. { ------ }
  1514. cmCut : ClipCut;
  1515. cmCopy : ClipCopy;
  1516. cmPaste : ClipPaste;
  1517. {$ifdef WinClipSupported}
  1518. cmCopyWin : ClipCopyWin;
  1519. cmPasteWin : ClipPasteWin;
  1520. {$endif WinClipSupported}
  1521. cmUndo : Undo;
  1522. cmRedo : Redo;
  1523. cmClear : DelSelect;
  1524. cmExpandCodeTemplate: ExpandCodeTemplate;
  1525. cmLocalMenu :
  1526. begin
  1527. P:=CurPos; Inc(P.X); Inc(P.Y);
  1528. LocalMenu(P);
  1529. end;
  1530. else
  1531. begin
  1532. DontClear:=true;
  1533. CCAction:=ccDontCare;
  1534. end;
  1535. end;
  1536. if DontClear=false then
  1537. ClearEvent(Event);
  1538. end;
  1539. {$ifdef TEST_PARTIAL_SYNTAX}
  1540. evIdle :
  1541. begin
  1542. { Complete syntax by 20 lines increment }
  1543. { could already be quite lengthy on slow systems }
  1544. if not SyntaxComplete then
  1545. UpdateAttrsRange(LastSyntaxedLine,LastSyntaxedLine+20,AttrAll);
  1546. end;
  1547. {$endif TEST_PARTIAL_SYNTAX}
  1548. evBroadcast :
  1549. begin
  1550. CCAction:=ccDontCare;
  1551. case Event.Command of
  1552. cmUpdate :
  1553. Update;
  1554. cmClearLineHighlights :
  1555. SetHighlightRow(-1);
  1556. cmResetDebuggerRow :
  1557. SetDebuggerRow(-1);
  1558. cmScrollBarChanged:
  1559. if (Event.InfoPtr = HScrollBar) or
  1560. (Event.InfoPtr = VScrollBar) then
  1561. begin
  1562. CheckScrollBar(HScrollBar, Delta.X);
  1563. CheckScrollBar(VScrollBar, Delta.Y);
  1564. end;
  1565. end;
  1566. end;
  1567. else CCAction:=ccDontCare;
  1568. end;
  1569. inherited HandleEvent(Event);
  1570. CurEvent:=OldEvent;
  1571. case CCAction of
  1572. ccCheck : CodeCompleteCheck;
  1573. ccClear : ClearCodeCompleteWord;
  1574. end;
  1575. end;
  1576. procedure TCodeEditor.UpdateUndoRedo(cm : word; action : byte);
  1577. var UndoMenu : PMenuItem;
  1578. begin
  1579. UndoMenu:=PAdvancedMenuBar(MenuBar)^.GetMenuItem(cm);
  1580. if assigned(UndoMenu) then
  1581. begin
  1582. If assigned(UndoMenu^.Param) then
  1583. DisposeStr(UndoMenu^.Param);
  1584. if action<lastaction then
  1585. UndoMenu^.Param:=NewStr(ActionString[action]);
  1586. end;
  1587. end;
  1588. procedure TCodeEditor.Update;
  1589. begin
  1590. LimitsChanged;
  1591. SelectionChanged; HighlightChanged;
  1592. UpdateIndicator;
  1593. DrawView;
  1594. end;
  1595. function TCodeEditor.GetLocalMenu: PMenu;
  1596. begin
  1597. GetLocalMenu:=nil;
  1598. end;
  1599. function TCodeEditor.GetCommandTarget: PView;
  1600. begin
  1601. GetCommandTarget:=@Self;
  1602. end;
  1603. function TCodeEditor.CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup;
  1604. var MV: PMenuPopup;
  1605. begin
  1606. New(MV, Init(Bounds, M));
  1607. CreateLocalMenuView:=MV;
  1608. end;
  1609. procedure TCodeEditor.LocalMenu(P: TPoint);
  1610. var M: PMenu;
  1611. MV: PMenuPopUp;
  1612. R: TRect;
  1613. Re: word;
  1614. begin
  1615. M:=GetLocalMenu;
  1616. if M=nil then Exit;
  1617. if LastLocalCmd<>0 then
  1618. M^.Default:=SearchMenuItem(M,LastLocalCmd);
  1619. Desktop^.GetExtent(R);
  1620. MakeGlobal(P,R.A); {Desktop^.MakeLocal(R.A,R.A);}
  1621. MV:=CreateLocalMenuView(R,M);
  1622. Re:=Application^.ExecView(MV);
  1623. if M^.Default=nil then LastLocalCmd:=0
  1624. else LastLocalCmd:=M^.Default^.Command;
  1625. Dispose(MV, Done);
  1626. if Re<>0 then
  1627. Message(GetCommandTarget,evCommand,Re,@Self);
  1628. end;
  1629. procedure TCodeEditor.Draw;
  1630. var SelectColor,
  1631. HighlightColColor,
  1632. HighlightRowColor,
  1633. ErrorMessageColor : word;
  1634. B: TDrawBuffer;
  1635. X,Y,AX,AY,MaxX: sw_integer;
  1636. PX: TPoint;
  1637. LineCount: sw_integer;
  1638. Line: PLine;
  1639. LineText,Format: string;
  1640. isBreak : boolean;
  1641. C: char;
  1642. FreeFormat: array[0..255] of boolean;
  1643. Color: word;
  1644. ColorTab: array[coFirstColor..coLastColor] of word;
  1645. ErrorLine: integer;
  1646. ErrorMsg: string[MaxViewWidth];
  1647. function CombineColors(Orig,Modifier: byte): byte;
  1648. var Color: byte;
  1649. begin
  1650. if (Modifier and $0f)=0 then
  1651. Color:=(Orig and $0f) or (Modifier and $f0)
  1652. else
  1653. Color:=(Orig and $f0) or (Modifier and $0f);
  1654. { do not allow invisible }
  1655. { use white as foreground in this case }
  1656. if (Color and $f) = ((Color div $10) and $7) then
  1657. Color:=(Color and $F0) or $F;
  1658. CombineColors:=Color;
  1659. end;
  1660. const NulLine : TLine = (Text: nil; Format: nil);
  1661. begin
  1662. if LockFlag>0 then
  1663. begin
  1664. DrawCalled:=true;
  1665. Exit;
  1666. end;
  1667. DrawCalled:=false;
  1668. ErrorMsg:=copy(GetErrorMessage,1,MaxViewWidth);
  1669. if ErrorMsg='' then ErrorLine:=-1 else
  1670. if (CurPos.Y-Delta.Y)<(Size.Y div 2) then ErrorLine:=Size.Y-1
  1671. else ErrorLine:=0;
  1672. LineCount:=GetLineCount;
  1673. ColorTab[coTextColor]:=GetColor(1);
  1674. ColorTab[coWhiteSpaceColor]:=GetColor(2);
  1675. ColorTab[coCommentColor]:=GetColor(3);
  1676. ColorTab[coReservedWordColor]:=GetColor(4);
  1677. ColorTab[coIdentifierColor]:=GetColor(5);
  1678. ColorTab[coStringColor]:=GetColor(6);
  1679. ColorTab[coNumberColor]:=GetColor(7);
  1680. ColorTab[coAssemblerColor]:=GetColor(8);
  1681. ColorTab[coSymbolColor]:=GetColor(9);
  1682. ColorTab[coDirectiveColor]:=GetColor(13);
  1683. ColorTab[coHexNumberColor]:=GetColor(14);
  1684. ColorTab[coTabColor]:=GetColor(15);
  1685. { break same as error }
  1686. ColorTab[coBreakColor]:=GetColor(16);
  1687. SelectColor:=GetColor(10);
  1688. HighlightColColor:=GetColor(11);
  1689. HighlightRowColor:=GetColor(12);
  1690. ErrorMessageColor:=GetColor(16);
  1691. {$ifdef TEST_PARTIAL_SYNTAX}
  1692. If LastSyntaxedLine<Delta.Y+Size.Y then
  1693. UpdateAttrsRange(LastSyntaxedLine,Delta.Y+Size.Y,AttrAll);
  1694. {$endif TEST_PARTIAL_SYNTAX}
  1695. for Y:=0 to Size.Y-1 do
  1696. if Y=ErrorLine then
  1697. begin
  1698. MoveChar(B,' ',ErrorMessageColor,Size.X);
  1699. MoveStr(B,ErrorMsg,ErrorMessageColor);
  1700. WriteLine(0,Y,Size.X,1,B);
  1701. end else
  1702. begin
  1703. AY:=Delta.Y+Y;
  1704. Color:=ColorTab[coTextColor];
  1705. FillChar(FreeFormat,SizeOf(FreeFormat),1);
  1706. MoveChar(B,' ',Color,Size.X);
  1707. if AY<LineCount then
  1708. begin
  1709. Line:=GetLine(AY);
  1710. IsBreak:=Lines^.at(AY)^.isBreakpoint;
  1711. end
  1712. else
  1713. begin
  1714. Line:=@NulLine;
  1715. IsBreak:=false;
  1716. end;
  1717. GetDisplayTextFormat(AY,LineText,Format);
  1718. { if FlagSet(efSyntaxHighlight) then MaxX:=length(LineText)+1
  1719. else }MaxX:=Size.X+Delta.X;
  1720. for X:=1 to Min(MaxX,255) do
  1721. begin
  1722. AX:=Delta.X+X-1;
  1723. if X<=length(LineText) then C:=LineText[X] else C:=' ';
  1724. PX.X:=AX-Delta.X; PX.Y:=AY;
  1725. if (Highlight.A.X<>Highlight.B.X) or (Highlight.A.Y<>Highlight.B.Y) then
  1726. begin
  1727. if (PointOfs(Highlight.A)<=PointOfs(PX)) and (PointOfs(PX)<PointOfs(Highlight.B)) then
  1728. begin
  1729. Color:=SelectColor;
  1730. FreeFormat[X]:=false;
  1731. end;
  1732. end else
  1733. { no highlight }
  1734. begin
  1735. if IsFlagSet(efVerticalBlocks) then
  1736. begin
  1737. if (SelStart.X<=AX) and (AX<=SelEnd.X) and
  1738. (SelStart.Y<=AY) and (AY<=SelEnd.Y) then
  1739. begin Color:=SelectColor; FreeFormat[X]:=false; end;
  1740. end else
  1741. if PointOfs(SelStart)<>PointOfs(SelEnd) then
  1742. if (PointOfs(SelStart)<=PointOfs(PX)) and (PointOfs(PX)<PointOfs(SelEnd)) then
  1743. begin Color:=SelectColor; FreeFormat[X]:=false; end;
  1744. end;
  1745. if FreeFormat[X] then
  1746. if X<=length(Format) then
  1747. {Color:=ColorTab[ord(Format[X])] else Color:=ColorTab[coTextColor];
  1748. this give BoundsCheckError with -Cr quite often PM }
  1749. Color:=ColorTab[ord(Format[X]) mod (coLastColor + 1)] else Color:=ColorTab[coTextColor];
  1750. if IsFlagSet(efHighlightRow) and
  1751. (PX.Y=CurPos.Y) and (HighlightRow=-1) then
  1752. begin
  1753. Color:=CombineColors(Color,HighlightRowColor);
  1754. FreeFormat[X]:=false;
  1755. end;
  1756. if IsFlagSet(efHighlightColumn) and (PX.X=CurPos.X) then
  1757. begin
  1758. Color:=CombineColors(Color,HighlightColColor);
  1759. FreeFormat[X]:=false;
  1760. end;
  1761. if HighlightRow=AY then
  1762. begin
  1763. Color:=CombineColors(Color,HighlightRowColor);
  1764. FreeFormat[X]:=false;
  1765. end;
  1766. if isbreak then
  1767. begin
  1768. Color:=ColorTab[coBreakColor];
  1769. FreeFormat[X]:=false;
  1770. end;
  1771. if DebuggerRow=AY then
  1772. begin
  1773. Color:=CombineColors(Color,HighlightRowColor);
  1774. FreeFormat[X]:=false;
  1775. end;
  1776. if (0<=X-1-Delta.X) and (X-1-Delta.X<MaxViewWidth) then
  1777. MoveChar(B[X-1-Delta.X],C,Color,1);
  1778. end;
  1779. WriteLine(0,Y,Size.X,1,B);
  1780. end;
  1781. DrawCursor;
  1782. end;
  1783. procedure TCodeEditor.DrawCursor;
  1784. begin
  1785. if lockflag>0 then
  1786. DrawCursorCalled:=true
  1787. else
  1788. SetCursor(CurPos.X-Delta.X,CurPos.Y-Delta.Y);
  1789. SetState(sfCursorIns,Overwrite);
  1790. end;
  1791. function TCodeEditor.Overwrite: boolean;
  1792. begin
  1793. Overwrite:=not IsFlagSet(efInsertMode);
  1794. end;
  1795. function TCodeEditor.GetLineCount: sw_integer;
  1796. begin
  1797. GetLineCount:=Lines^.Count;
  1798. end;
  1799. function TCodeEditor.GetLine(I: sw_integer): PLine;
  1800. begin
  1801. GetLine:=Lines^.At(I);
  1802. end;
  1803. function TCodeEditor.CharIdxToLinePos(Line,CharIdx: sw_integer): sw_integer;
  1804. var S: string;
  1805. CP,RX: sw_integer;
  1806. begin
  1807. S:=GetLineText(Line);
  1808. CP:=1; RX:=0;
  1809. while (CP<=length(S)) and (CP<=CharIdx) do
  1810. begin
  1811. if S[CP]=TAB then
  1812. Inc(RX,TabSize-(RX mod TabSize))
  1813. else
  1814. Inc(RX);
  1815. Inc(CP);
  1816. end;
  1817. CharIdxToLinePos:=RX-1;
  1818. end;
  1819. function TCodeEditor.LinePosToCharIdx(Line,X: sw_integer): sw_integer;
  1820. var S: string;
  1821. CP,RX: sw_integer;
  1822. begin
  1823. S:=GetLineText(Line);
  1824. if S='' then
  1825. CP:=0
  1826. else
  1827. begin
  1828. CP:=0; RX:=0;
  1829. while (RX<=X) and (CP<=length(S)) do
  1830. begin
  1831. Inc(CP);
  1832. if S[CP]=TAB then
  1833. Inc(RX,TabSize-(RX mod TabSize))
  1834. else
  1835. Inc(RX);
  1836. end;
  1837. end;
  1838. LinePosToCharIdx:=CP;
  1839. end;
  1840. {function TCodeEditor.GetLineTextPos(Line,X: integer): integer;
  1841. var
  1842. S: string;
  1843. rx,i : Sw_integer;
  1844. begin
  1845. S:=GetLineText(Line);
  1846. i:=0; rx:=0;
  1847. while (RX<X) and (i<Length(s)) do
  1848. begin
  1849. inc(i);
  1850. inc(rx);
  1851. if s[i]=#9 then
  1852. inc(rx,TabSize-(rx mod tabsize));
  1853. end;
  1854. if RX<X then Inc(I,X-RX);
  1855. GetLineTextPos:=i;
  1856. end;
  1857. function TCodeEditor.GetDisplayTextPos(Line,X: integer): integer;
  1858. var
  1859. S: string;
  1860. L: PLine;
  1861. rx,i : Sw_integer;
  1862. begin
  1863. S:='';
  1864. if Line<Lines^.Count then
  1865. begin
  1866. L:=Lines^.At(Line);
  1867. if assigned(L^.Text) then
  1868. S:=L^.Text^;
  1869. end;
  1870. i:=0;
  1871. rx:=0;
  1872. while (i<X) and (i<Length(s)) do
  1873. begin
  1874. inc(i);
  1875. inc(rx);
  1876. if s[i]=#9 then
  1877. inc(rx,TabSize-(rx mod tabsize));
  1878. end;
  1879. GetDisplayTextPos:=rx;
  1880. end;}
  1881. function TCodeEditor.GetLineText(I: sw_integer): string;
  1882. var
  1883. L : PLine;
  1884. begin
  1885. GetLineText:='';
  1886. if I<Lines^.Count then
  1887. begin
  1888. L:=Lines^.At(I);
  1889. if assigned(L^.Text) then
  1890. GetLineText:=L^.Text^;
  1891. end;
  1892. end;
  1893. procedure TCodeEditor.SetLineText(I: sw_integer;const S: string);
  1894. var
  1895. L : PLine;
  1896. AddCount : Sw_Integer;
  1897. begin
  1898. AddCount:=0;
  1899. while (Lines^.Count<I+1) do
  1900. begin
  1901. Lines^.Insert(NewLine(''));
  1902. Inc(AddCount);
  1903. end;
  1904. if AddCount>0 then
  1905. LimitsChanged;
  1906. L:=Lines^.At(I);
  1907. if assigned(L^.Text) then
  1908. DisposeStr(L^.Text);
  1909. L^.Text:=NewStr(S);
  1910. end;
  1911. procedure TCodeEditor.SetLineBreakState(I : sw_integer;b : boolean);
  1912. var PL : PLine;
  1913. begin
  1914. if (i>0) and (i<=Lines^.Count) then
  1915. PL:=Lines^.At(i-1)
  1916. else
  1917. exit;
  1918. if assigned(PL) then
  1919. PL^.isbreakpoint:=b;
  1920. DrawView;
  1921. end;
  1922. function TCodeEditor.GetDisplayText(I: sw_integer): string;
  1923. begin
  1924. GetDisplayText:=ExtractTabs(GetLineText(I),TabSize);
  1925. end;
  1926. procedure TCodeEditor.SetDisplayText(I: sw_integer;const S: string);
  1927. begin
  1928. { I disagree here
  1929. I don't want the editor to change the position of the tabs
  1930. in my makefiles !! PM
  1931. if FlagSet(efUseTabCharacters) and (TabSize>0) then
  1932. SetLineText(I,CompressUsingTabs(S,TabSize))
  1933. else }
  1934. { ... then you better make this optional - Gabor }
  1935. SetLineText(I,S);
  1936. end;
  1937. procedure TCodeEditor.GetDisplayTextFormat(I: sw_integer;var DT,DF:string);
  1938. var
  1939. L : PLine;
  1940. P,PAdd : SW_Integer;
  1941. begin
  1942. DF:='';
  1943. DT:='';
  1944. if I<Lines^.Count then
  1945. begin
  1946. L:=Lines^.At(I);
  1947. if assigned(L^.Text) then
  1948. begin
  1949. if assigned(L^.Format)=false then DF:='' else
  1950. DF:=L^.Format^;
  1951. DT:=L^.Text^;
  1952. p:=0;
  1953. while p<length(DT) do
  1954. begin
  1955. inc(p);
  1956. if DT[p]=#9 then
  1957. begin
  1958. PAdd:=TabSize-((p-1) mod TabSize);
  1959. if DF<>'' then
  1960. DF:=copy(DF,1,P-1)+CharStr(DF[p],PAdd)+copy(DF,P+1,255);
  1961. DT:=copy(DT,1,P-1)+CharStr(' ',PAdd)+copy(DT,P+1,255);
  1962. inc(P,PAdd-1);
  1963. end;
  1964. end;
  1965. end;
  1966. end;
  1967. end;
  1968. function TCodeEditor.GetLineFormat(I: sw_integer): string;
  1969. var P: PLine;
  1970. S: string;
  1971. begin
  1972. if I<GetLineCount then P:=Lines^.At(I) else P:=nil;
  1973. if (P=nil) or (P^.Format=nil) then S:='' else
  1974. S:=P^.Format^;
  1975. GetLineFormat:=S;
  1976. end;
  1977. procedure TCodeEditor.SetLineFormat(I: sw_integer;const S: string);
  1978. var P: PLine;
  1979. begin
  1980. if I<GetLineCount then
  1981. begin
  1982. P:=Lines^.At(I);
  1983. if P^.Format<>nil then DisposeStr(P^.Format);
  1984. P^.Format:=NewStr(S);
  1985. end;
  1986. end;
  1987. procedure TCodeEditor.DeleteAllLines;
  1988. begin
  1989. if Assigned(Lines) then
  1990. Lines^.FreeAll;
  1991. end;
  1992. procedure TCodeEditor.DeleteLine(I: sw_integer);
  1993. var
  1994. CP : Tpoint;
  1995. begin
  1996. if I<Lines^.Count then
  1997. begin
  1998. if StoreUndo then
  1999. begin
  2000. CP.X:=0;CP.Y:=I;
  2001. AddAction(eaDeleteLine,CP,CP,GetLineText(I));
  2002. end;
  2003. Lines^.AtFree(I);
  2004. end;
  2005. end;
  2006. procedure TCodeEditor.AddLine(const S: string);
  2007. begin
  2008. Lines^.Insert(NewLine(S));
  2009. end;
  2010. function TCodeEditor.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
  2011. begin
  2012. GetSpecSymbolCount:=0;
  2013. end;
  2014. function TCodeEditor.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string;
  2015. begin
  2016. GetSpecSymbol:='';
  2017. Abstract;
  2018. end;
  2019. function TCodeEditor.IsReservedWord(const S: string): boolean;
  2020. begin
  2021. IsReservedWord:=false;
  2022. end;
  2023. function TCodeEditor.TranslateCodeTemplate(const Shortcut: string; ALines: PUnsortedStringCollection): boolean;
  2024. begin
  2025. TranslateCodeTemplate:=false;
  2026. end;
  2027. function TCodeEditor.CompleteCodeWord(const WordS: string; var Text: string): boolean;
  2028. begin
  2029. CompleteCodeWord:=false;
  2030. end;
  2031. function TCodeEditor.GetCodeCompleteWord: string;
  2032. begin
  2033. GetCodeCompleteWord:=GetStr(CodeCompleteWord);
  2034. end;
  2035. procedure TCodeEditor.SetCodeCompleteWord(const S: string);
  2036. begin
  2037. if Assigned(CodeCompleteWord) then DisposeStr(CodeCompleteWord);
  2038. CodeCompleteWord:=NewStr(S);
  2039. if S<>'' then
  2040. SetCompleteState(csOffering)
  2041. else
  2042. SetCompleteState(csInactive);
  2043. end;
  2044. procedure TCodeEditor.ClearCodeCompleteWord;
  2045. begin
  2046. SetCodeCompleteWord('');
  2047. SetCompleteState(csInactive);
  2048. end;
  2049. procedure TCodeEditor.Indent;
  2050. var S, PreS: string;
  2051. Shift: integer;
  2052. begin
  2053. S:=GetLineText(CurPos.Y);
  2054. if CurPos.Y>0 then
  2055. PreS:=RTrim(GetLineText(CurPos.Y-1),not IsFlagSet(efUseTabCharacters))
  2056. else
  2057. PreS:='';
  2058. if CurPos.X>=length(PreS) then
  2059. Shift:=TabSize
  2060. else
  2061. begin
  2062. Shift:=1;
  2063. while (CurPos.X+Shift<length(PreS)) and (PreS[CurPos.X+Shift]<>' ') do
  2064. Inc(Shift);
  2065. end;
  2066. SetLineText(CurPos.Y,RExpand(copy(S,1,CurPos.X+1),CurPos.X+1)+CharStr(' ',Shift)+copy(S,CurPos.X+2,255));
  2067. SetCurPtr(CurPos.X+Shift,CurPos.Y);
  2068. UpdateAttrs(CurPos.Y,attrAll);
  2069. DrawLines(CurPos.Y);
  2070. SetModified(true);
  2071. end;
  2072. procedure TCodeEditor.CharLeft;
  2073. begin
  2074. if CurPos.X=0 then Exit;
  2075. SetCurPtr(CurPos.X-1,CurPos.Y);
  2076. end;
  2077. procedure TCodeEditor.CharRight;
  2078. begin
  2079. if CurPos.X>=MaxLineLength then
  2080. Exit;
  2081. SetCurPtr(CurPos.X+1,CurPos.Y);
  2082. end;
  2083. procedure TCodeEditor.WordLeft;
  2084. var X, Y: sw_integer;
  2085. Line: string;
  2086. GotIt,FoundNonSeparator: boolean;
  2087. begin
  2088. X:=CurPos.X;
  2089. Y:=CurPos.Y;
  2090. GotIt:=false;
  2091. FoundNonSeparator:=false;
  2092. while (Y>=0) do
  2093. begin
  2094. if Y=CurPos.Y then
  2095. begin
  2096. X:=length(GetDisplayText(Y));
  2097. if CurPos.X<X then
  2098. X:=CurPos.X; Dec(X);
  2099. if (X=-1) then
  2100. begin
  2101. Dec(Y);
  2102. if Y>=0 then
  2103. X:=length(GetDisplayText(Y));
  2104. Break;
  2105. end;
  2106. end
  2107. else
  2108. X:=length(GetDisplayText(Y))-1;
  2109. Line:=GetDisplayText(Y);
  2110. while (X>=0) and (GotIt=false) do
  2111. begin
  2112. if FoundNonSeparator then
  2113. begin
  2114. if IsWordSeparator(Line[X+1]) then
  2115. begin
  2116. Inc(X);
  2117. GotIt:=true;
  2118. Break;
  2119. end;
  2120. end
  2121. else
  2122. if not IsWordSeparator(Line[X+1]) then
  2123. FoundNonSeparator:=true;
  2124. Dec(X);
  2125. if (X=0) and (IsWordSeparator(Line[1])=false) then
  2126. begin
  2127. GotIt:=true;
  2128. Break;
  2129. end;
  2130. end;
  2131. if GotIt then
  2132. Break;
  2133. X:=0;
  2134. Dec(Y);
  2135. if Y>=0 then
  2136. begin
  2137. X:=length(GetDisplayText(Y));
  2138. Break;
  2139. end;
  2140. end;
  2141. if Y<0 then Y:=0; if X<0 then X:=0;
  2142. SetCurPtr(X,Y);
  2143. end;
  2144. procedure TCodeEditor.WordRight;
  2145. var X, Y: sw_integer;
  2146. Line: string;
  2147. GotIt: boolean;
  2148. begin
  2149. X:=CurPos.X; Y:=CurPos.Y; GotIt:=false;
  2150. while (Y<GetLineCount) do
  2151. begin
  2152. if Y=CurPos.Y then
  2153. begin
  2154. X:=CurPos.X; Inc(X);
  2155. if (X>length(GetDisplayText(Y))-1) then
  2156. begin Inc(Y); X:=0; end;
  2157. end else X:=0;
  2158. Line:=GetDisplayText(Y);
  2159. while (X<=length(Line)+1) and (GotIt=false) and (Line<>'') do
  2160. begin
  2161. if X=length(Line)+1 then begin GotIt:=true; Dec(X); Break end;
  2162. if IsWordSeparator(Line[X]) then
  2163. begin
  2164. while (Y<GetLineCount) and
  2165. (X<=length(Line)) and (IsWordSeparator(Line[X])) do
  2166. begin
  2167. Inc(X);
  2168. if X>=length(Line) then
  2169. begin GotIt:=true; Dec(X); Break; end;
  2170. end;
  2171. if (GotIt=false) and (X<length(Line)) then
  2172. begin
  2173. Dec(X);
  2174. GotIt:=true;
  2175. Break;
  2176. end;
  2177. end;
  2178. Inc(X);
  2179. end;
  2180. if GotIt then Break;
  2181. X:=0;
  2182. Inc(Y);
  2183. if (Y<GetLineCount) then
  2184. begin
  2185. Line:=GetDisplayText(Y);
  2186. if (Line<>'') and (IsWordSeparator(Line[1])=false) then Break;
  2187. end;
  2188. end;
  2189. if Y=GetLineCount then Y:=GetLineCount-1;
  2190. SetCurPtr(X,Y);
  2191. end;
  2192. procedure TCodeEditor.LineStart;
  2193. begin
  2194. SetCurPtr(0,CurPos.Y);
  2195. end;
  2196. procedure TCodeEditor.LineEnd;
  2197. var
  2198. s : string;
  2199. i : longint;
  2200. begin
  2201. if CurPos.Y<GetLineCount then
  2202. begin
  2203. s:=GetDisplayText(CurPos.Y);
  2204. i:=length(s);
  2205. while (i>0) and (s[i]=' ') do
  2206. dec(i);
  2207. SetCurPtr(i,CurPos.Y);
  2208. end
  2209. else
  2210. SetCurPtr(0,CurPos.Y);
  2211. end;
  2212. procedure TCodeEditor.LineUp;
  2213. begin
  2214. if CurPos.Y>0 then
  2215. SetCurPtr(CurPos.X,CurPos.Y-1);
  2216. end;
  2217. procedure TCodeEditor.LineDown;
  2218. begin
  2219. if (CurPos.Y<GetLineCount-1) then
  2220. SetCurPtr(CurPos.X,CurPos.Y+1);
  2221. end;
  2222. procedure TCodeEditor.PageUp;
  2223. begin
  2224. ScrollTo(Delta.X,Max(Delta.Y-Size.Y,0));
  2225. SetCurPtr(CurPos.X,Max(0,CurPos.Y-(Size.Y)));
  2226. end;
  2227. procedure TCodeEditor.PageDown;
  2228. begin
  2229. ScrollTo(Delta.X,Min(Delta.Y+Size.Y,GetLineCount-1));
  2230. SetCurPtr(CurPos.X,Min(GetLineCount-1,CurPos.Y+(Size.Y{-1})));
  2231. end;
  2232. procedure TCodeEditor.TextStart;
  2233. begin
  2234. SetCurPtr(0,0);
  2235. end;
  2236. procedure TCodeEditor.TextEnd;
  2237. var s : string;
  2238. i : longint;
  2239. begin
  2240. s:=GetDisplayText(GetLineCount-1);
  2241. i:=length(s);
  2242. while (i>0) and (s[i]=' ') do
  2243. dec(i);
  2244. SetCurPtr(i,GetLineCount-1);
  2245. end;
  2246. procedure TCodeEditor.JumpSelStart;
  2247. begin
  2248. if ValidBlock then
  2249. SetCurPtr(SelStart.X,SelStart.Y);
  2250. end;
  2251. procedure TCodeEditor.JumpSelEnd;
  2252. begin
  2253. if ValidBlock then
  2254. SetCurPtr(SelEnd.X,SelEnd.Y);
  2255. end;
  2256. procedure TCodeEditor.JumpMark(MarkIdx: integer);
  2257. begin
  2258. if (MarkIdx<Low(Bookmarks)) or (MarkIdx>High(Bookmarks)) then
  2259. begin ErrorBox('Invalid mark index ('+IntToStr(MarkIdx)+')',nil); Exit; end;
  2260. with Bookmarks[MarkIdx] do
  2261. if Valid=false then
  2262. InformationBox('Mark '+IntToStr(MarkIdx)+' not set.',nil)
  2263. else
  2264. SetCurPtr(Pos.X,Pos.Y);
  2265. end;
  2266. procedure TCodeEditor.DefineMark(MarkIdx: integer);
  2267. begin
  2268. if (MarkIdx<Low(Bookmarks)) or (MarkIdx>High(Bookmarks)) then
  2269. begin
  2270. ErrorBox('Invalid mark index ('+IntToStr(MarkIdx)+')',nil);
  2271. Exit;
  2272. end;
  2273. with Bookmarks[MarkIdx] do
  2274. begin
  2275. Pos:=CurPos;
  2276. Valid:=true;
  2277. end;
  2278. end;
  2279. procedure TCodeEditor.JumpToLastCursorPos;
  2280. {$ifdef Undo}
  2281. var
  2282. pa : PEditorAction;
  2283. {$endif Undo}
  2284. begin
  2285. {$ifdef Undo}
  2286. if (UndoList^.count>0) and (RedoList^.count=0) then
  2287. begin
  2288. { Or should we just call Undo ?? PM }
  2289. pa:=UndoList^.At(UndoList^.count-1);
  2290. if (pa^.action=eaMoveCursor) then
  2291. SetCurPtr(pa^.StartPos.X,pa^.StartPos.Y);
  2292. end;
  2293. {$else not Undo}
  2294. NotImplemented;
  2295. {$endif Undo}
  2296. end;
  2297. function TCodeEditor.InsertLine: Sw_integer;
  2298. var Ind: Sw_integer;
  2299. S,IndentStr: string;
  2300. procedure CalcIndent(LineOver: Sw_integer);
  2301. begin
  2302. if (LineOver<0) or (LineOver>GetLineCount) then Ind:=0 else
  2303. begin
  2304. IndentStr:=GetLineText(LineOver);
  2305. Ind:=0;
  2306. while (Ind<length(IndentStr)) and (IndentStr[Ind+1]=' ') do
  2307. Inc(Ind);
  2308. end;
  2309. IndentStr:=CharStr(' ',Ind);
  2310. end;
  2311. var SelBack: sw_integer;
  2312. SCP: TPoint;
  2313. HoldUndo : Boolean;
  2314. begin
  2315. if IsReadOnly then begin InsertLine:=-1; Exit; end;
  2316. Lock;
  2317. SCP:=CurPos;
  2318. HoldUndo:=StoreUndo;
  2319. StoreUndo:=false;
  2320. if CurPos.Y<GetLineCount then S:=GetLineText(CurPos.Y) else S:='';
  2321. if Overwrite=false then
  2322. begin
  2323. SelBack:=0;
  2324. if GetLineCount>0 then
  2325. begin
  2326. S:=GetDisplayText(CurPos.Y);
  2327. SelBack:=length(S)-SelEnd.X;
  2328. SetDisplayText(CurPos.Y,RTrim(S,not IsFlagSet(efUseTabCharacters)));
  2329. end;
  2330. SetDisplayText(CurPos.Y,copy(S,1,CurPos.X-1+1));
  2331. CalcIndent(CurPos.Y);
  2332. Lines^.AtInsert(CurPos.Y+1,NewLine(IndentStr+copy(S,CurPos.X+1,255)));
  2333. LimitsChanged;
  2334. (* if PointOfs(SelStart)<>PointOfs(SelEnd) then { !!! check it - it's buggy !!! }
  2335. begin SelEnd.Y:=CurPos.Y+1; SelEnd.X:=length(GetLineText(CurPos.Y+1))-SelBack; end;*)
  2336. UpdateAttrs(CurPos.Y,attrAll);
  2337. SetCurPtr(Ind,CurPos.Y+1);
  2338. {$ifdef Undo}
  2339. StoreUndo:=HoldUndo;
  2340. Addaction(eaInsertLine,SCP,CurPos,IndentStr);
  2341. StoreUndo:=false;
  2342. {$endif Undo}
  2343. AdjustSelection(CurPos.X-SCP.X,CurPos.Y-SCP.Y);
  2344. end else
  2345. begin
  2346. CalcIndent(CurPos.Y);
  2347. if CurPos.Y=GetLineCount-1 then
  2348. begin
  2349. Lines^.Insert(NewLine(IndentStr));
  2350. AdjustSelection(0,1);
  2351. LimitsChanged;
  2352. {$ifdef Undo}
  2353. StoreUndo:=HoldUndo;
  2354. UpdateAttrs(CurPos.Y,attrAll);
  2355. SetCurPtr(Ind,CurPos.Y+1);
  2356. Addaction(eaInsertLine,SCP,CurPos,IndentStr);
  2357. StoreUndo:=false;
  2358. {$endif Undo}
  2359. end
  2360. else
  2361. begin
  2362. UpdateAttrs(CurPos.Y,attrAll);
  2363. StoreUndo:=HoldUndo;
  2364. SetCurPtr(Ind,CurPos.Y+1);
  2365. StoreUndo:=false;
  2366. end;
  2367. end;
  2368. DrawLines(CurPos.Y);
  2369. StoreUndo:=HoldUndo;
  2370. SetModified(true);
  2371. Unlock;
  2372. end;
  2373. procedure TCodeEditor.BreakLine;
  2374. begin
  2375. NotImplemented; Exit;
  2376. end;
  2377. procedure TCodeEditor.BackSpace;
  2378. var S,PreS: string;
  2379. OI,CI,CP,Y,TX: Sw_integer;
  2380. SCP,SC1 : TPoint;
  2381. HoldUndo : Boolean;
  2382. begin
  2383. if IsReadOnly then Exit;
  2384. Lock;
  2385. SCP:=CurPos;
  2386. HoldUndo:=StoreUndo;
  2387. StoreUndo:=false;
  2388. if CurPos.X=0 then
  2389. begin
  2390. if CurPos.Y>0 then
  2391. begin
  2392. S:=GetLineText(CurPos.Y-1);
  2393. SetLineText(CurPos.Y-1,S+GetLineText(CurPos.Y));
  2394. SC1.X:=Length(S);SC1.Y:=CurPOS.Y-1;
  2395. StoreUndo:=HoldUndo;
  2396. AddAction(eaDeleteLine,SCP,SC1,GetLineText(CurPos.Y));
  2397. StoreUndo:=false;
  2398. DeleteLine(CurPos.Y);
  2399. LimitsChanged;
  2400. SetCurPtr(length(S),CurPos.Y-1);
  2401. end;
  2402. end
  2403. else
  2404. begin
  2405. S:=GetDisplayText(CurPos.Y);
  2406. CP:=CurPos.X-1;
  2407. if IsFlagSet(efBackspaceUnindents) then
  2408. if Trim(copy(S,1,CP+1))='' then
  2409. begin
  2410. Y:=CurPos.Y;
  2411. while (Y>0) do
  2412. begin
  2413. Dec(Y);
  2414. PreS:=GetDisplayText(Y);
  2415. if Trim(copy(PreS,1,CP+1))<>'' then Break;
  2416. end;
  2417. if Y<0 then PreS:='';
  2418. { while (CP>0) and
  2419. ( (CP>length(S)) or (S[CP]=' ') ) and
  2420. ( (CP>length(PreS)) or (PreS[CP]<>' ') ) do
  2421. Dec(CP);}
  2422. TX:=0;
  2423. while (TX<length(PreS)) and (PreS[TX+1]=' ') do
  2424. Inc(TX);
  2425. if TX<CP then CP:=TX;
  2426. end;
  2427. S:=GetLineText(CurPos.Y);
  2428. OI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
  2429. CI:=LinePosToCharIdx(CurPos.Y,CP);
  2430. SetLineText(CurPos.Y,copy(S,1,CI-1)+copy(S,OI,255));
  2431. SetCurPtr(CP,CurPos.Y);
  2432. {$ifdef Undo}
  2433. StoreUndo:=HoldUndo;
  2434. Addaction(eaDeleteText,SCP,CurPos,Copy(S,CI,OI-CI));
  2435. StoreUndo:=false;
  2436. {$endif Undo}
  2437. end;
  2438. UpdateAttrs(CurPos.Y,attrAll);
  2439. AdjustSelection(CurPos.X-SCP.X,CurPos.Y-SCP.Y);
  2440. DrawLines(CurPos.Y);
  2441. StoreUndo:=HoldUndo;
  2442. SetModified(true);
  2443. Unlock;
  2444. end;
  2445. procedure TCodeEditor.DelChar;
  2446. var S: string;
  2447. SDX,SDY,CI : sw_integer;
  2448. HoldUndo : boolean;
  2449. SCP : TPoint;
  2450. begin
  2451. if IsReadOnly then Exit;
  2452. Lock;
  2453. HoldUndo:=StoreUndo;
  2454. StoreUndo:=false;
  2455. S:=GetLineText(CurPos.Y);
  2456. if CurPos.X>=length(S) then
  2457. begin
  2458. if CurPos.Y<GetLineCount-1 then
  2459. begin
  2460. SetLineText(CurPos.Y,S+CharStr(' ',CurPOS.X-Length(S))+GetLineText(CurPos.Y+1));
  2461. StoreUndo:=HoldUndo;
  2462. SCP.X:=0;SCP.Y:=CurPos.Y+1;
  2463. AddAction(eaDeleteLine,SCP,CurPos,GetLineText(CurPos.Y+1));
  2464. StoreUndo:=false;
  2465. DeleteLine(CurPos.Y+1);
  2466. LimitsChanged;
  2467. SDX:=0; SDY:=-1;
  2468. end;
  2469. end
  2470. else
  2471. begin
  2472. { Problem if S[CurPos.X+1]=TAB !! PM }
  2473. CI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
  2474. if S[CI]=TAB then
  2475. begin
  2476. S:=Copy(S,1,CI-1)+CharStr(' ',TabSize-1)+Copy(S,CI+1,255);
  2477. {$ifdef Undo}
  2478. StoreUndo:=HoldUndo;
  2479. Addaction(eaDeleteText,CurPos,CurPos,' ');
  2480. StoreUndo:=false;
  2481. {$endif Undo}
  2482. end
  2483. else
  2484. begin
  2485. {$ifdef Undo}
  2486. StoreUndo:=HoldUndo;
  2487. Addaction(eaDeleteText,CurPos,CurPos,S[CI]);
  2488. StoreUndo:=false;
  2489. {$endif Undo}
  2490. Delete(S,CI,1);
  2491. end;
  2492. SetLineText(CurPos.Y,S);
  2493. SDX:=-1; SDY:=0;
  2494. end;
  2495. SetCurPtr(CurPos.X,CurPos.Y);
  2496. UpdateAttrs(CurPos.Y,attrAll);
  2497. AdjustSelection(SDX,SDY);
  2498. DrawLines(CurPos.Y);
  2499. StoreUndo:=HoldUndo;
  2500. SetModified(true);
  2501. Unlock;
  2502. end;
  2503. procedure TCodeEditor.DelWord;
  2504. var
  2505. SP,EP : TPoint;
  2506. SelSize : sw_integer;
  2507. begin
  2508. if IsReadOnly then Exit;
  2509. Lock;
  2510. SP:=SelStart;
  2511. EP:=SelEnd;
  2512. SelectWord;
  2513. SelSize:=SelEnd.X-SelStart.X;
  2514. DelSelect;
  2515. SetSelection(SP,EP);
  2516. AdjustSelectionPos(CurPos.X,CurPos.Y,SelSize,0);
  2517. SetModified(true);
  2518. Unlock;
  2519. end;
  2520. procedure TCodeEditor.DelStart;
  2521. var S: string;
  2522. begin
  2523. if IsReadOnly then Exit;
  2524. Lock;
  2525. S:=GetLineText(CurPos.Y);
  2526. if (S<>'') and (CurPos.X<>0) then
  2527. begin
  2528. SetLineText(CurPos.Y,copy(S,LinePosToCharIdx(CurPos.Y,CurPos.X),255));
  2529. SetCurPtr(0,CurPos.Y);
  2530. UpdateAttrs(CurPos.Y,attrAll);
  2531. DrawLines(CurPos.Y);
  2532. SetModified(true);
  2533. end;
  2534. Unlock;
  2535. end;
  2536. procedure TCodeEditor.DelEnd;
  2537. var S: string;
  2538. begin
  2539. if IsReadOnly then Exit;
  2540. Lock;
  2541. S:=GetLineText(CurPos.Y);
  2542. if (S<>'') and (CurPos.X<>length(S)) then
  2543. begin
  2544. SetLineText(CurPos.Y,copy(S,1,LinePosToCharIdx(CurPos.Y,CurPos.X)-1));
  2545. SetCurPtr(CurPos.X,CurPos.Y);
  2546. UpdateAttrs(CurPos.Y,attrAll);
  2547. DrawLines(CurPos.Y);
  2548. SetModified(true);
  2549. end;
  2550. Unlock;
  2551. end;
  2552. procedure TCodeEditor.DelLine;
  2553. var
  2554. HoldUndo : boolean;
  2555. SP : TPoint;
  2556. begin
  2557. if IsReadOnly then Exit;
  2558. Lock;
  2559. if GetLineCount>0 then
  2560. begin
  2561. SP:=CurPos;
  2562. DeleteLine(CurPos.Y);
  2563. HoldUndo:=StoreUndo;
  2564. StoreUndo:=false;
  2565. LimitsChanged;
  2566. AdjustSelection(0,-1);
  2567. SetCurPtr(0,CurPos.Y);
  2568. UpdateAttrs(Max(0,CurPos.Y-1),attrAll);
  2569. DrawLines(CurPos.Y);
  2570. If HoldUndo then
  2571. with UndoList^.At(UndoList^.count-1)^ do
  2572. begin
  2573. EndPos:=CurPos;
  2574. StartPos:=SP;
  2575. end;
  2576. StoreUndo:=HoldUndo;
  2577. SetModified(true);
  2578. end;
  2579. Unlock;
  2580. end;
  2581. procedure TCodeEditor.InsMode;
  2582. begin
  2583. SetInsertMode(Overwrite);
  2584. end;
  2585. function TCodeEditor.GetCurrentWord : string;
  2586. const WordChars = ['A'..'Z','a'..'z','0'..'9','_'];
  2587. var P : TPoint;
  2588. S : String;
  2589. StartPos,EndPos : byte;
  2590. begin
  2591. P:=CurPos;
  2592. S:=GetLineText(P.Y);
  2593. StartPos:=P.X+1;
  2594. EndPos:=StartPos;
  2595. if not (S[StartPos] in WordChars) then
  2596. GetCurrentWord:=''
  2597. else
  2598. begin
  2599. While (StartPos>0) and (S[StartPos-1] in WordChars) do
  2600. Dec(StartPos);
  2601. While (EndPos<Length(S)) and (S[EndPos+1] in WordChars) do
  2602. Inc(EndPos);
  2603. GetCurrentWord:=Copy(S,StartPos,EndPos-StartPos+1);
  2604. end;
  2605. end;
  2606. procedure TCodeEditor.StartSelect;
  2607. var P1,P2: TPoint;
  2608. begin
  2609. if ValidBlock=false then
  2610. begin
  2611. { SetSelection(SelStart,Limit);}
  2612. P1:=CurPos; P1.X:=0; P2:=CurPos; {P2.X:=length(GetLineText(P2.Y))+1;}
  2613. SetSelection(P1,P2);
  2614. end
  2615. else
  2616. SetSelection(CurPos,SelEnd);
  2617. if PointOfs(SelEnd)<PointOfs(SelStart) then
  2618. SetSelection(SelStart,SelStart);
  2619. CheckSels;
  2620. DrawView;
  2621. end;
  2622. procedure TCodeEditor.EndSelect;
  2623. var P: TPoint;
  2624. LS: sw_integer;
  2625. begin
  2626. P:=CurPos;
  2627. { P.X:=Min(SelEnd.X,length(GetLineText(SelEnd.Y)));}
  2628. LS:=length(GetLineText(SelEnd.Y));
  2629. if LS<P.X then P.X:=LS;
  2630. CheckSels;
  2631. SetSelection(SelStart,P);
  2632. DrawView;
  2633. end;
  2634. procedure TCodeEditor.DelSelect;
  2635. var LineDelta, LineCount, CurLine: Sw_integer;
  2636. StartX,EndX,LastX: Sw_integer;
  2637. S: string;
  2638. SPos : TPoint;
  2639. begin
  2640. if IsReadOnly or (ValidBlock=false) then Exit;
  2641. Lock;
  2642. LineCount:=(SelEnd.Y-SelStart.Y)+1;
  2643. LineDelta:=0; LastX:=CurPos.X;
  2644. CurLine:=SelStart.Y;
  2645. while (LineDelta<LineCount) do
  2646. begin
  2647. S:=GetDisplayText(CurLine);
  2648. if LineDelta=0 then StartX:=SelStart.X else StartX:=0;
  2649. if LineDelta=LineCount-1 then EndX:=SelEnd.X else EndX:=length(S);
  2650. if (LineDelta<LineCount-1) and ((StartX=0) and (EndX>=length(S))) then
  2651. begin
  2652. { delete the complete line }
  2653. DeleteLine(CurLine);
  2654. if CurLine>0 then
  2655. LastX:=length(GetDisplayText(CurLine-1))
  2656. else
  2657. LastX:=0;
  2658. end
  2659. else
  2660. begin
  2661. if StoreUndo then
  2662. begin
  2663. SPos.X:=StartX;
  2664. SPos.Y:=CurLine;
  2665. AddAction(eaDeleteText,SPos,SPos,Copy(S,StartX+1,EndX-StartX));
  2666. end;
  2667. SetDisplayText(CurLine,RExpand(copy(S,1,StartX),StartX)+copy(S,EndX+1,255));
  2668. LastX:=StartX;
  2669. if (StartX=0) and (0<LineDelta) and
  2670. not(((LineDelta=LineCount-1) and (StartX=0) and (StartX=EndX))) then
  2671. begin
  2672. S:=GetDisplayText(CurLine-1);
  2673. SetDisplayText(CurLine-1,S+GetLineText(CurLine));
  2674. DeleteLine(CurLine);
  2675. LastX:=length(S);
  2676. end
  2677. else
  2678. Inc(CurLine);
  2679. end;
  2680. Inc(LineDelta);
  2681. end;
  2682. HideSelect;
  2683. SetCurPtr(LastX,CurLine-1);
  2684. UpdateAttrs(CurPos.Y,attrAll);
  2685. DrawLines(CurPos.Y);
  2686. SetModified(true);
  2687. UnLock;
  2688. end;
  2689. procedure TCodeEditor.HideSelect;
  2690. begin
  2691. SetSelection(CurPos,CurPos);
  2692. DrawLines(Delta.Y);
  2693. end;
  2694. procedure TCodeEditor.CopyBlock;
  2695. var Temp: PCodeEditor;
  2696. R: TRect;
  2697. begin
  2698. if IsReadOnly or (ValidBlock=false) then Exit;
  2699. Lock;
  2700. GetExtent(R);
  2701. New(Temp, Init(R, nil, nil, nil,0));
  2702. Temp^.InsertFrom(@Self);
  2703. Temp^.SelectAll(true);
  2704. { this selects one line too much because
  2705. we have a empty line at creation to avoid
  2706. negative line problems so we need to decrease SelEnd.Y }
  2707. Dec(Temp^.SelEnd.Y);
  2708. InsertFrom(Temp);
  2709. Dispose(Temp, Done);
  2710. UnLock;
  2711. end;
  2712. procedure TCodeEditor.MoveBlock;
  2713. var Temp: PCodeEditor;
  2714. R: TRect;
  2715. OldPos: TPoint;
  2716. begin
  2717. if IsReadOnly then Exit;
  2718. if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
  2719. Lock;
  2720. GetExtent(R);
  2721. New(Temp, Init(R, nil, nil, nil,0));
  2722. Temp^.InsertFrom(@Self);
  2723. OldPos:=CurPos;
  2724. if CurPos.Y>SelStart.Y then
  2725. Dec(OldPos.Y,Temp^.GetLineCount-1);
  2726. DelSelect;
  2727. SetCurPtr(OldPos.X,OldPos.Y);
  2728. InsertFrom(Temp);
  2729. Dispose(Temp, Done);
  2730. UnLock;
  2731. end;
  2732. procedure TCodeEditor.IndentBlock;
  2733. var
  2734. ey,i : Sw_integer;
  2735. S : String;
  2736. begin
  2737. if IsReadOnly then Exit;
  2738. if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
  2739. Lock;
  2740. ey:=selend.y;
  2741. if selend.x=0 then
  2742. dec(ey);
  2743. for i:=selstart.y to ey do
  2744. begin
  2745. S:=GetLineText(i);
  2746. SetLineText(i,' '+S);
  2747. end;
  2748. SetCurPtr(CurPos.X,CurPos.Y);
  2749. UpdateAttrsRange(SelStart.Y,SelEnd.Y,attrAll);
  2750. DrawLines(CurPos.Y);
  2751. SetModified(true);
  2752. UnLock;
  2753. end;
  2754. procedure TCodeEditor.UnindentBlock;
  2755. var
  2756. ey,i : Sw_integer;
  2757. S : String;
  2758. begin
  2759. if IsReadOnly then Exit;
  2760. if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
  2761. Lock;
  2762. ey:=selend.y;
  2763. if selend.x=0 then
  2764. dec(ey);
  2765. for i:=selstart.y to ey do
  2766. begin
  2767. S:=GetLineText(i);
  2768. if (length(s)>1) and (S[1]=' ') then
  2769. Delete(s,1,1);
  2770. SetLineText(i,S);
  2771. end;
  2772. SetCurPtr(CurPos.X,CurPos.Y);
  2773. UpdateAttrsRange(SelStart.Y,SelEnd.Y,attrAll);
  2774. DrawLines(CurPos.Y);
  2775. SetModified(true);
  2776. UnLock;
  2777. end;
  2778. procedure TCodeEditor.SelectWord;
  2779. const WordChars = ['A'..'Z','a'..'z','0'..'9','_'];
  2780. var S : String;
  2781. StartPos,EndPos : byte;
  2782. A,B: TPoint;
  2783. begin
  2784. A:=CurPos;
  2785. B:=CurPos;
  2786. S:=GetLineText(A.Y);
  2787. StartPos:=A.X+1;
  2788. EndPos:=StartPos;
  2789. if not (S[StartPos] in WordChars) then
  2790. exit
  2791. else
  2792. begin
  2793. While (StartPos>0) and (S[StartPos-1] in WordChars) do
  2794. Dec(StartPos);
  2795. While (EndPos<Length(S)) and (S[EndPos+1] in WordChars) do
  2796. Inc(EndPos);
  2797. A.X:=StartPos-1;
  2798. B.X:=EndPos;
  2799. SetSelection(A,B);
  2800. end;
  2801. end;
  2802. procedure TCodeEditor.SelectLine;
  2803. var A,B: TPoint;
  2804. begin
  2805. if CurPos.Y<GetLineCount then
  2806. begin
  2807. A.Y:=CurPos.Y; A.X:=0;
  2808. B.Y:=CurPos.Y+1; B.X:=0;
  2809. SetSelection(A,B);
  2810. end;
  2811. end;
  2812. procedure TCodeEditor.WriteBlock;
  2813. var FileName: string;
  2814. S: PBufStream;
  2815. begin
  2816. if ValidBlock=false then Exit;
  2817. FileName:='';
  2818. if EditorDialog(edWriteBlock, @FileName) <> cmCancel then
  2819. begin
  2820. FileName := FExpand(FileName);
  2821. New(S, Init(FileName, stCreate, 4096));
  2822. if (S=nil) or (S^.Status<>stOK) then
  2823. EditorDialog(edCreateError,@FileName)
  2824. else
  2825. if SaveAreaToStream(S,SelStart,SelEnd)=false then
  2826. EditorDialog(edWriteError,@FileName);
  2827. if Assigned(S) then Dispose(S, Done);
  2828. end;
  2829. end;
  2830. procedure TCodeEditor.ReadBlock;
  2831. var FileName: string;
  2832. S: PBufStream;
  2833. E: PCodeEditor;
  2834. R: TRect;
  2835. begin
  2836. FileName:='';
  2837. if EditorDialog(edReadBlock, @FileName) <> cmCancel then
  2838. begin
  2839. FileName := FExpand(FileName);
  2840. New(S, Init(FileName, stOpenRead, 4096));
  2841. if (S=nil) or (S^.Status<>stOK) then
  2842. EditorDialog(edReadError,@FileName)
  2843. else
  2844. begin
  2845. R.Assign(0,0,0,0);
  2846. New(E, Init(R,nil,nil,nil,0));
  2847. if E^.LoadFromStream(S)=false then
  2848. EditorDialog(edReadError,@FileName)
  2849. else
  2850. begin
  2851. E^.SelectAll(true);
  2852. Self.InsertFrom(E);
  2853. end;
  2854. Dispose(E, Done);
  2855. end;
  2856. if Assigned(S) then Dispose(S, Done);
  2857. end;
  2858. end;
  2859. procedure TCodeEditor.PrintBlock;
  2860. begin
  2861. NotImplemented; Exit;
  2862. end;
  2863. procedure TCodeEditor.ExpandCodeTemplate;
  2864. var OSS,OSE: TPoint;
  2865. Line,ShortCut: string;
  2866. X,Y,I,LineIndent: sw_integer;
  2867. CodeLines: PUnsortedStringCollection;
  2868. CanJump: boolean;
  2869. begin
  2870. {
  2871. The usage of editing primitives in this routine make it pretty slow, but
  2872. its speed is still acceptable and they make the implementation of Undo
  2873. much easier... - Gabor
  2874. }
  2875. if IsReadOnly then Exit;
  2876. Lock;
  2877. Line:=GetDisplayText(CurPos.Y);
  2878. X:=CurPos.X; ShortCut:='';
  2879. if X<=length(Line) then
  2880. while (X>0) and (Line[X] in (NumberChars+AlphaChars)) do
  2881. begin
  2882. ShortCut:=Line[X]+ShortCut;
  2883. Dec(X);
  2884. end;
  2885. if ShortCut<>'' then
  2886. begin
  2887. New(CodeLines, Init(10,10));
  2888. if TranslateCodeTemplate(ShortCut,CodeLines) then
  2889. begin
  2890. LineIndent:=X;
  2891. SetCurPtr(X,CurPos.Y);
  2892. for I:=1 to length(ShortCut) do
  2893. DelChar;
  2894. for Y:=0 to CodeLines^.Count-1 do
  2895. begin
  2896. CanJump:=false;
  2897. if Y>0 then
  2898. begin
  2899. CanJump:=Trim(GetLineText(CurPos.Y))='';
  2900. if CanJump=false then
  2901. begin
  2902. for X:=1 to LineIndent do { indent template lines to align }
  2903. AddChar(' '); { them to the first line }
  2904. end
  2905. else
  2906. SetCurPtr(CurPos.X+LineIndent,CurPos.Y);
  2907. end;
  2908. Line:=CodeLines^.At(Y)^;
  2909. for X:=1 to length(Line) do
  2910. AddChar(Line[X]);
  2911. if Y<CodeLines^.Count-1 then
  2912. begin
  2913. InsertLine; { line break }
  2914. if CanJump=false then
  2915. begin
  2916. while CurPos.X>0 do { unindent }
  2917. begin
  2918. SetCurPtr(CurPos.X-1,CurPos.Y);
  2919. DelChar;
  2920. end;
  2921. end
  2922. else
  2923. SetCurPtr(0,CurPos.Y);
  2924. end;
  2925. end;
  2926. end;
  2927. Dispose(CodeLines, Done);
  2928. end;
  2929. UnLock;
  2930. end;
  2931. procedure TCodeEditor.AddChar(C: char);
  2932. const OpenBrackets : string[10] = '[({';
  2933. CloseBrackets : string[10] = '])}';
  2934. var S,SC,TabS: string;
  2935. BI: byte;
  2936. CI,TabStart,LocTabSize : Sw_integer;
  2937. SP: TPoint;
  2938. HoldUndo : boolean;
  2939. begin
  2940. if IsReadOnly then Exit;
  2941. Lock;
  2942. SP:=CurPos;
  2943. HoldUndo:=StoreUndo;
  2944. StoreUndo:=false;
  2945. if (C<>TAB) or IsFlagSet(efUseTabCharacters) then
  2946. SC:=C
  2947. else
  2948. begin
  2949. LocTabSize:=TabSize - (CurPos.X mod TabSize);
  2950. if (CurPos.Y<=1) or not IsFlagSet(efAutoIndent) then
  2951. SC:=CharStr(' ',LocTabSize)
  2952. else
  2953. begin
  2954. S:=GetLineText(CurPos.Y-1);
  2955. BI:=CurPos.X+1;
  2956. while (BI<=Length(S)) and (S[BI]=' ') do
  2957. inc(BI);
  2958. if (BI=CurPos.X+1) or (BI>Length(S)) then
  2959. SC:=CharStr(' ',LocTabSize)
  2960. else
  2961. SC:=CharStr(' ',BI-CurPos.X-1);
  2962. end;
  2963. end;
  2964. S:=GetLineText(CurPos.Y);
  2965. if CharIdxToLinePos(CurPos.Y,length(S))<CurPos.X then
  2966. begin
  2967. S:=S+CharStr(' ',CurPos.X-CharIdxToLinePos(CurPos.Y,length(S)){-1});
  2968. SetLineText(CurPos.Y,S);
  2969. end;
  2970. CI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
  2971. if (CI>0) and (S[CI]=TAB) then
  2972. begin
  2973. if CI=1 then
  2974. TabStart:=0
  2975. else
  2976. TabStart:=CharIdxToLinePos(CurPos.Y,CI-1)+1;
  2977. if SC=Tab then TabS:=Tab else
  2978. TabS:=CharStr(' ',CurPos.X-TabStart);
  2979. SetLineText(CurPos.Y,copy(S,1,CI-1)+TabS+SC+copy(S,CI+1,255));
  2980. SetCurPtr(CharIdxToLinePos(CurPos.Y,CI+length(TabS)+length(SC)),CurPos.Y);
  2981. end
  2982. else
  2983. begin
  2984. if Overwrite and (CI<=length(S)) then
  2985. SetLineText(CurPos.Y,copy(S,1,CI-1)+SC+copy(S,CI+length(SC),255))
  2986. else
  2987. SetLineText(CurPos.Y,copy(S,1,CI-1)+SC+copy(S,CI,255));
  2988. SetCurPtr(CharIdxToLinePos(CurPos.Y,CI+length(SC)),CurPos.Y);
  2989. end;
  2990. {$ifdef Undo}
  2991. { must be before CloseBrackets !! }
  2992. StoreUndo:=HoldUndo;
  2993. Addaction(eaInsertText,SP,CurPos,C);
  2994. StoreUndo:=false;
  2995. {$endif Undo}
  2996. if IsFlagSet(efAutoBrackets) then
  2997. begin
  2998. BI:=Pos(C,OpenBrackets);
  2999. if (BI>0) then
  3000. begin
  3001. StoreUndo:=HoldUndo;
  3002. AddChar(CloseBrackets[BI]);
  3003. StoreUndo:=false;
  3004. SetCurPtr(CurPos.X-1,CurPos.Y);
  3005. end;
  3006. end;
  3007. UpdateAttrs(CurPos.Y,attrAll);
  3008. AdjustSelection(CurPos.X-SP.X,CurPos.Y-SP.Y);
  3009. DrawLines(CurPos.Y);
  3010. StoreUndo:=HoldUndo;
  3011. SetModified(true);
  3012. UnLock;
  3013. end;
  3014. function TCodeEditor.ClipCopy: Boolean;
  3015. var OK: boolean;
  3016. begin
  3017. Lock;
  3018. {AddGroupedAction(eaCopy);
  3019. can we undo a copy ??
  3020. maybe as an Undo Paste in Clipboard !! }
  3021. OK:=Clipboard<>nil;
  3022. if OK then OK:=Clipboard^.InsertFrom(@Self);
  3023. ClipCopy:=OK;
  3024. UnLock;
  3025. end;
  3026. procedure TCodeEditor.ClipCut;
  3027. begin
  3028. if IsReadOnly then Exit;
  3029. Lock;
  3030. AddGroupedAction(eaCut);
  3031. DontConsiderShiftState:=true;
  3032. if Clipboard<>nil then
  3033. if Clipboard^.InsertFrom(@Self) then
  3034. begin
  3035. if not IsClipBoard then
  3036. DelSelect;
  3037. SetModified(true);
  3038. end;
  3039. CloseGroupedAction(eaCut);
  3040. UnLock;
  3041. DontConsiderShiftState:=false;
  3042. end;
  3043. procedure TCodeEditor.ClipPaste;
  3044. begin
  3045. if IsReadOnly then Exit;
  3046. DontConsiderShiftState:=true;
  3047. Lock;
  3048. AddGroupedAction(eaPaste);
  3049. if Clipboard<>nil then
  3050. begin
  3051. InsertFrom(Clipboard);
  3052. SetModified(true);
  3053. end;
  3054. CloseGroupedAction(eaPaste);
  3055. UnLock;
  3056. DontConsiderShiftState:=false;
  3057. end;
  3058. {$ifdef WinClipSupported}
  3059. function TCodeEditor.ClipPasteWin: Boolean;
  3060. var OK: boolean;
  3061. l,i : longint;
  3062. p,p10,p2,p13 : pchar;
  3063. s : string;
  3064. BPos,EPos,StorePos : TPoint;
  3065. first : boolean;
  3066. begin
  3067. Lock;
  3068. OK:=WinClipboardSupported;
  3069. if OK then
  3070. begin
  3071. first:=true;
  3072. StorePos:=CurPos;
  3073. i:=CurPos.Y;
  3074. l:=GetTextWinClipboardSize;
  3075. if l=0 then
  3076. OK:=false
  3077. else
  3078. OK:=GetTextWinClipBoardData(p,l);
  3079. if OK then
  3080. begin
  3081. AddGroupedAction(eaPasteWin);
  3082. p2:=p;
  3083. p13:=strpos(p,#13);
  3084. p10:=strpos(p,#10);
  3085. while assigned(p10) do
  3086. begin
  3087. if p13+1=p10 then
  3088. p13[0]:=#0
  3089. else
  3090. p10[0]:=#0;
  3091. s:=strpas(p2);
  3092. if first then
  3093. begin
  3094. { we need to cut the line in two
  3095. if not at end of line PM }
  3096. InsertLine;
  3097. SetCurPtr(StorePos.X,StorePos.Y);
  3098. InsertText(s);
  3099. first:=false;
  3100. end
  3101. else
  3102. begin
  3103. Inc(i);
  3104. Lines^.AtInsert(i,NewLine(s));
  3105. BPos.X:=0;BPos.Y:=i;
  3106. EPOS.X:=Length(s);EPos.Y:=i;
  3107. AddAction(eaInsertLine,BPos,EPos,S);
  3108. end;
  3109. if p13+1=p10 then
  3110. p13[0]:=#13
  3111. else
  3112. p10[0]:=#10;
  3113. p2:=@p10[1];
  3114. p13:=strpos(p2,#13);
  3115. p10:=strpos(p2,#10);
  3116. end;
  3117. if strlen(p2)>0 then
  3118. begin
  3119. s:=strpas(p2);
  3120. if not first then
  3121. SetCurPtr(0,i+1);
  3122. InsertText(s);
  3123. end;
  3124. SetCurPtr(StorePos.X,StorePos.Y);
  3125. SetModified(true);
  3126. UpdateAttrs(StorePos.Y,attrAll);
  3127. CloseGroupedAction(eaPasteWin);
  3128. Update;
  3129. { we must free the allocated memory }
  3130. freemem(p,l);
  3131. end;
  3132. end;
  3133. ClipPasteWin:=OK;
  3134. UnLock;
  3135. end;
  3136. function TCodeEditor.ClipCopyWin: Boolean;
  3137. var OK: boolean;
  3138. p,p2 : pchar;
  3139. s : string;
  3140. i,str_begin,str_end,NumLines,PcLength : longint;
  3141. begin
  3142. NumLines:=SelEnd.Y-SelStart.Y;
  3143. if (NumLines>0) or (SelEnd.X>SelStart.X) then
  3144. Inc(NumLines);
  3145. if NumLines=0 then
  3146. exit;
  3147. Lock;
  3148. { First calculate needed size }
  3149. { for newlines first + 1 for terminal #0 }
  3150. PcLength:=Length(EOL)*(NumLines-1)+1;
  3151. { overestimated but can not be that big PM }
  3152. for i:=SelStart.Y to SelEnd.Y do
  3153. PCLength:=PCLength+Length(GetLineText(i));
  3154. getmem(p,PCLength);
  3155. i:=SelStart.Y;
  3156. s:=GetLineText(i);
  3157. str_begin:=LinePosToCharIdx(i,SelStart.X);
  3158. if SelEnd.Y>SelStart.Y then
  3159. str_end:=255
  3160. else
  3161. str_end:=LinePosToCharIdx(i,SelEnd.X)-1;
  3162. s:=copy(s,str_begin,str_end-str_begin+1);
  3163. strpcopy(p,s);
  3164. p2:=strend(p);
  3165. inc(i);
  3166. while i<SelEnd.Y do
  3167. begin
  3168. strpcopy(p2,EOL+GetLineText(i));
  3169. p2:=strend(p2);
  3170. Inc(i);
  3171. end;
  3172. if SelEnd.Y>SelStart.Y then
  3173. begin
  3174. s:=copy(GetLineText(i),1,LinePosToCharIdx(i,SelEnd.X)-1);
  3175. strpcopy(p2,EOL+s);
  3176. end;
  3177. OK:=WinClipboardSupported;
  3178. if OK then
  3179. begin
  3180. OK:=SetTextWinClipBoardData(p,strlen(p));
  3181. end;
  3182. ClipCopyWin:=OK;
  3183. Freemem(p,PCLength);
  3184. UnLock;
  3185. end;
  3186. {$endif WinClipSupported}
  3187. procedure TCodeEditor.Undo;
  3188. {$ifdef Undo}
  3189. var
  3190. Temp,Idx,Last,Count : Longint;
  3191. Is_grouped : boolean;
  3192. {$endif Undo}
  3193. begin
  3194. {$ifdef Undo}
  3195. StoreUndo := False;
  3196. Lock;
  3197. if UndoList^.count > 0 then
  3198. begin
  3199. Last:=UndoList^.count-1;
  3200. if UndoList^.At(Last)^.Is_grouped_action then
  3201. begin
  3202. Count:=UndoList^.At(Last)^.ActionCount;
  3203. Dec(Last);
  3204. Is_grouped:=true;
  3205. end
  3206. else
  3207. begin
  3208. Count:=1;
  3209. Is_grouped:=false;
  3210. end;
  3211. for Idx:=Last downto Last-Count+1 do
  3212. with UndoList^.At(Idx)^ do
  3213. begin
  3214. case action of
  3215. eaMoveCursor :
  3216. begin
  3217. { move cursor back to original position }
  3218. SetCurPtr(startpos.x,startpos.y);
  3219. end;
  3220. eaInsertText :
  3221. begin
  3222. SetCurPtr(StartPos.X,StartPos.Y);
  3223. if assigned(text) then
  3224. for Temp := 1 to length(Text^) do
  3225. DelChar;
  3226. end;
  3227. eaDeleteText :
  3228. begin
  3229. { reinsert deleted text }
  3230. SetCurPtr(EndPos.X,EndPos.Y);
  3231. if assigned(text) then
  3232. for Temp := 1 to length(Text^) do
  3233. AddChar(Text^[Temp]);
  3234. SetCurPtr(StartPos.X,StartPos.Y);
  3235. end;
  3236. eaInsertLine :
  3237. begin
  3238. SetCurPtr(EndPos.X,EndPos.Y);
  3239. SetDisplayText(EndPos.Y,Copy(GetDisplayText(EndPos.Y),EndPos.X+1,255));
  3240. BackSpace;
  3241. SetCurPtr(StartPos.X,StartPos.Y);
  3242. end;
  3243. eaDeleteLine :
  3244. begin
  3245. SetCurPtr(EndPos.X,EndPos.Y);
  3246. DelEnd;
  3247. InsertLine;
  3248. SetCurPtr(StartPos.X,StartPos.Y);
  3249. SetLineText(StartPos.Y,GetStr(Text));
  3250. end;
  3251. eaSelectionChanged :
  3252. begin
  3253. { move cursor to end of last set selection }
  3254. end;
  3255. else
  3256. { what the 'ell's an undefined action doing round 'ere mate! }
  3257. end; { once this lot is done paste into redo and modify to suit needs }
  3258. { move item to redo stack }
  3259. RedoList^.Insert(UndoList^.At(Idx));
  3260. UpdateUndoRedo(cmRedo,UndoList^.At(Idx)^.Action);
  3261. UndoList^.atDelete(Idx);
  3262. If Idx>0 then
  3263. UpdateUndoRedo(cmUndo,UndoList^.At(Idx-1)^.Action)
  3264. else
  3265. UpdateUndoRedo(cmUndo,0);
  3266. end;{Idx loop for grouped actions }
  3267. if is_grouped then
  3268. begin
  3269. Idx:=UndoList^.Count-1;
  3270. RedoList^.Insert(UndoList^.At(Idx));
  3271. UpdateUndoRedo(cmRedo,UndoList^.At(Idx)^.Action);
  3272. UndoList^.atDelete(Idx);
  3273. If Idx>0 then
  3274. UpdateUndoRedo(cmUndo,UndoList^.At(Idx-1)^.Action)
  3275. else
  3276. UpdateUndoRedo(cmUndo,0);
  3277. end;
  3278. if UndoList^.count=0 then
  3279. SetCmdState(UndoCmd,false);
  3280. SetCmdState(RedoCmd,true);
  3281. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  3282. DrawView;
  3283. end;
  3284. StoreUndo := True;
  3285. Unlock;
  3286. {$else}
  3287. NotImplemented; Exit;
  3288. {$endif Undo}
  3289. end;
  3290. procedure TCodeEditor.Redo;
  3291. {$ifdef Undo}
  3292. var
  3293. Temp,Idx,Last,Count : Longint;
  3294. Is_grouped : boolean;
  3295. {$endif Undo}
  3296. begin
  3297. {$ifdef Undo}
  3298. StoreUndo := False;
  3299. Lock;
  3300. if RedoList^.count <> 0 then
  3301. begin
  3302. Last:=RedoList^.count-1;
  3303. if RedoList^.At(Last)^.Is_grouped_action then
  3304. begin
  3305. Count:=RedoList^.At(Last)^.ActionCount;
  3306. Dec(Last);
  3307. Is_grouped:=true;
  3308. end
  3309. else
  3310. begin
  3311. Count:=1;
  3312. Is_grouped:=false;
  3313. end;
  3314. for Idx:=Last downto Last-Count+1 do
  3315. with RedoList^.At(Idx)^ do
  3316. begin
  3317. case action of
  3318. eaMoveCursor :
  3319. begin
  3320. { move cursor back to original position }
  3321. SetCurPtr(EndPos.X,EndPos.Y);
  3322. end;
  3323. eaInsertText :
  3324. begin
  3325. SetCurPtr(startpos.x,startpos.y);
  3326. InsertText(GetStr(Text));
  3327. end;
  3328. eaDeleteText :
  3329. begin
  3330. SetCurPtr(EndPos.X,EndPos.Y);
  3331. for Temp := 1 to length(GetStr(Text)) do
  3332. DelChar;
  3333. end;
  3334. eaInsertLine :
  3335. begin
  3336. SetCurPtr(StartPos.X,StartPos.Y);
  3337. InsertLine;
  3338. SetCurPtr(StartPos.X,StartPos.Y);
  3339. InsertText(GetStr(Text));
  3340. SetCurPtr(EndPos.X,EndPos.Y);
  3341. end;
  3342. eaDeleteLine :
  3343. begin
  3344. SetCurPtr(StartPos.X,StartPos.Y);
  3345. DeleteLine(StartPos.Y);
  3346. { SetCurPtr(EndPos.X,EndPos.Y);
  3347. for Temp := 1 to length(GetStr(Text)) do
  3348. DelChar;}
  3349. SetCurPtr(EndPos.X,EndPos.Y);
  3350. end;
  3351. eaSelectionChanged :
  3352. begin
  3353. { move cursor to end of last set test selection }
  3354. end;
  3355. else
  3356. { what the 'ell's an undefined action doing round 'ere mate! }
  3357. end; { once this lot is done paste back into undo and modify to suit needs }
  3358. { move item to undo stack }
  3359. UndoList^.Insert(RedoList^.At(Idx));
  3360. UpdateUndoRedo(cmUndo,RedoList^.At(Idx)^.Action);
  3361. If Idx>0 then
  3362. UpdateUndoRedo(cmRedo,RedoList^.At(Idx-1)^.Action)
  3363. else
  3364. UpdateUndoRedo(cmRedo,0);
  3365. RedoList^.atDelete(Idx);
  3366. end;{ Idx loop for grouped action }
  3367. If is_grouped then
  3368. begin
  3369. Idx:=RedoList^.count-1;
  3370. UndoList^.Insert(RedoList^.At(Idx));
  3371. UpdateUndoRedo(cmUndo,RedoList^.At(Idx)^.Action);
  3372. If Idx>0 then
  3373. UpdateUndoRedo(cmRedo,RedoList^.At(Idx-1)^.Action)
  3374. else
  3375. UpdateUndoRedo(cmRedo,0);
  3376. RedoList^.atDelete(Idx);
  3377. end;
  3378. if RedoList^.count=0 then
  3379. SetCmdState(RedoCmd,false);
  3380. SetCmdState(UndoCmd,true);
  3381. DrawView;
  3382. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  3383. end;
  3384. StoreUndo := True;
  3385. Unlock;
  3386. {$else}
  3387. NotImplemented; Exit;
  3388. {$endif Undo}
  3389. end;
  3390. procedure TCodeEditor.GotoLine;
  3391. var
  3392. GotoRec: TGotoLineDialogRec;
  3393. begin
  3394. with GotoRec do
  3395. begin
  3396. LineNo:='1';
  3397. Lines:=GetLineCount;
  3398. if EditorDialog(edGotoLine, @GotoRec) <> cmCancel then
  3399. begin
  3400. SetCurPtr(0,StrToInt(LineNo)-1);
  3401. TrackCursor(true);
  3402. end;
  3403. end;
  3404. end;
  3405. procedure TCodeEditor.Find;
  3406. var
  3407. FindRec: TFindDialogRec;
  3408. DoConf: boolean;
  3409. begin
  3410. with FindRec do
  3411. begin
  3412. Find := FindStr;
  3413. if GetCurrentWord<>'' then
  3414. Find:=GetCurrentWord;
  3415. Options := (FindFlags and ffmOptions) shr ffsOptions;
  3416. Direction := (FindFlags and ffmDirection) shr ffsDirection;
  3417. Scope := (FindFlags and ffmScope) shr ffsScope;
  3418. Origin := (FindFlags and ffmOrigin) shr ffsOrigin;
  3419. DoConf:= (FindFlags and ffPromptOnReplace)<>0;
  3420. if EditorDialog(edFind, @FindRec) <> cmCancel then
  3421. begin
  3422. FindStr := Find;
  3423. FindFlags := (Options shl ffsOptions) or (Direction shl ffsDirection) or
  3424. (Scope shl ffsScope) or (Origin shl ffsOrigin);
  3425. FindFlags := FindFlags and not ffDoReplace;
  3426. if DoConf then
  3427. FindFlags := (FindFlags or ffPromptOnReplace);
  3428. SearchRunCount:=0;
  3429. DoSearchReplace;
  3430. end;
  3431. end;
  3432. end;
  3433. procedure TCodeEditor.Replace;
  3434. var
  3435. ReplaceRec: TReplaceDialogRec;
  3436. Re: word;
  3437. begin
  3438. if IsReadOnly then Exit;
  3439. with ReplaceRec do
  3440. begin
  3441. Find := FindStr;
  3442. if GetCurrentWord<>'' then
  3443. Find:=GetCurrentWord;
  3444. Replace := ReplaceStr;
  3445. Options := (FindFlags and ffmOptions) shr ffsOptions;
  3446. Direction := (FindFlags and ffmDirection) shr ffsDirection;
  3447. Scope := (FindFlags and ffmScope) shr ffsScope;
  3448. Origin := (FindFlags and ffmOrigin) shr ffsOrigin;
  3449. Re:=EditorDialog(edReplace, @ReplaceRec);
  3450. if Re <> cmCancel then
  3451. begin
  3452. FindStr := Find;
  3453. ReplaceStr := Replace;
  3454. FindFlags := (Options shl ffsOptions) or (Direction shl ffsDirection) or
  3455. (Scope shl ffsScope) or (Origin shl ffsOrigin);
  3456. FindFlags := FindFlags or ffDoReplace;
  3457. if Re = cmYes then
  3458. FindFlags := FindFlags or ffReplaceAll;
  3459. SearchRunCount:=0;
  3460. DoSearchReplace;
  3461. end;
  3462. end;
  3463. end;
  3464. procedure TCodeEditor.DoSearchReplace;
  3465. var S: string;
  3466. DX,DY,P,Y,X: sw_integer;
  3467. Count: sw_integer;
  3468. Found,CanExit: boolean;
  3469. SForward,DoReplace,DoReplaceAll: boolean;
  3470. LeftOK,RightOK: boolean;
  3471. FoundCount: sw_integer;
  3472. A,B: TPoint;
  3473. AreaStart,AreaEnd: TPoint;
  3474. CanReplace,Confirm: boolean;
  3475. Re: word;
  3476. IFindStr : string;
  3477. BT : BTable;
  3478. function ContainsText(const SubS:string;var S: string; Start: Sw_word): Sw_integer;
  3479. var
  3480. P: Sw_Integer;
  3481. begin
  3482. if Start<=0 then
  3483. P:=0
  3484. else
  3485. begin
  3486. if SForward then
  3487. begin
  3488. if Start>length(s) then
  3489. P:=0
  3490. else if FindFlags and ffCaseSensitive<>0 then
  3491. P:=BMFScan(S[Start],length(s)+1-Start,FindStr,Bt)+1
  3492. else
  3493. P:=BMFIScan(S[Start],length(s)+1-Start,IFindStr,Bt)+1;
  3494. if P>0 then
  3495. Inc(P,Start-1);
  3496. end
  3497. else
  3498. begin
  3499. if start>length(s) then
  3500. start:=length(s);
  3501. if FindFlags and ffCaseSensitive<>0 then
  3502. P:=BMBScan(S[1],Start,FindStr,Bt)+1
  3503. else
  3504. P:=BMBIScan(S[1],Start,IFindStr,Bt)+1;
  3505. end;
  3506. end;
  3507. ContainsText:=P;
  3508. end;
  3509. function InArea(X,Y: sw_integer): boolean;
  3510. begin
  3511. InArea:=((AreaStart.Y=Y) and (AreaStart.X<=X)) or
  3512. ((AreaStart.Y<Y) and (Y<AreaEnd.Y)) or
  3513. ((AreaEnd.Y=Y) and (X<=AreaEnd.X));
  3514. end;
  3515. var CurDY: sw_integer;
  3516. begin
  3517. Inc(SearchRunCount);
  3518. SForward:=(FindFlags and ffmDirection)=ffForward;
  3519. DoReplace:=(FindFlags and ffDoReplace)<>0;
  3520. Confirm:=(FindFlags and ffPromptOnReplace)<>0;
  3521. DoReplaceAll:=(FindFlags and ffReplaceAll)<>0;
  3522. Count:=GetLineCount; FoundCount:=0;
  3523. if SForward then
  3524. DY:=1
  3525. else
  3526. DY:=-1;
  3527. DX:=DY;
  3528. if (FindFlags and ffmScope)=ffGlobal then
  3529. begin
  3530. AreaStart.X:=0;
  3531. AreaStart.Y:=0;
  3532. AreaEnd.X:=length(GetDisplayText(Count-1));
  3533. AreaEnd.Y:=Count-1;
  3534. end
  3535. else
  3536. begin
  3537. AreaStart:=SelStart;
  3538. AreaEnd:=SelEnd;
  3539. end;
  3540. X:=CurPos.X-DX;
  3541. Y:=CurPos.Y;;
  3542. if SearchRunCount=1 then
  3543. if (FindFlags and ffmOrigin)=ffEntireScope then
  3544. if SForward then
  3545. begin
  3546. X:=AreaStart.X-1;
  3547. Y:=AreaStart.Y;
  3548. end
  3549. else
  3550. begin
  3551. X:=AreaEnd.X+1;
  3552. Y:=AreaEnd.Y;
  3553. end;
  3554. if FindFlags and ffCaseSensitive<>0 then
  3555. begin
  3556. if SForward then
  3557. BMFMakeTable(FindStr,bt)
  3558. else
  3559. BMBMakeTable(FindStr,bt);
  3560. end
  3561. else
  3562. begin
  3563. IFindStr:=Upper(FindStr);
  3564. if SForward then
  3565. BMFMakeTable(IFindStr,bt)
  3566. else
  3567. BMBMakeTable(IFindStr,bt);
  3568. end;
  3569. inc(X,DX);
  3570. CanExit:=false;
  3571. if (DoReplace=false) or ((Confirm=false) and (Owner<>nil)) then
  3572. Owner^.Lock;
  3573. if InArea(X,Y) then
  3574. repeat
  3575. CurDY:=DY;
  3576. S:=GetDisplayText(Y);
  3577. P:=ContainsText(FindStr,S,X+1);
  3578. Found:=P<>0;
  3579. if Found then
  3580. begin
  3581. A.X:=P-1;
  3582. A.Y:=Y;
  3583. B.Y:=Y;
  3584. B.X:=A.X+length(FindStr);
  3585. end;
  3586. Found:=Found and InArea(A.X,A.Y);
  3587. if Found and ((FindFlags and ffWholeWordsOnly)<>0) then
  3588. begin
  3589. LeftOK:=(A.X<=0) or (not( (S[A.X] in AlphaChars) or (S[A.X] in NumberChars) ));
  3590. RightOK:=(B.X>=length(S)) or (not( (S[B.X+1] in AlphaChars) or (S[B.X+1] in NumberChars) ));
  3591. Found:=LeftOK and RightOK;
  3592. if Found=false then
  3593. begin
  3594. CurDY:=0;
  3595. X:=B.X+1;
  3596. end;
  3597. end;
  3598. if Found then
  3599. Inc(FoundCount);
  3600. if Found then
  3601. begin
  3602. Lock;
  3603. if SForward then
  3604. SetCurPtr(B.X,B.Y)
  3605. else
  3606. SetCurPtr(A.X,A.Y);
  3607. TrackCursor(true);
  3608. SetHighlight(A,B);
  3609. UnLock;
  3610. CurDY:=0;
  3611. if (DoReplace=false) then
  3612. begin
  3613. CanExit:=true;
  3614. If SForward then
  3615. begin
  3616. X:=B.X;
  3617. Y:=B.Y;
  3618. end
  3619. else
  3620. begin
  3621. X:=A.X;
  3622. Y:=A.Y;
  3623. end;
  3624. end
  3625. else
  3626. begin
  3627. if Confirm=false then CanReplace:=true else
  3628. begin
  3629. Re:=EditorDialog(edReplacePrompt,@CurPos);
  3630. case Re of
  3631. cmYes :
  3632. CanReplace:=true;
  3633. cmNo :
  3634. CanReplace:=false;
  3635. else {cmCancel}
  3636. begin
  3637. CanReplace:=false;
  3638. CanExit:=true;
  3639. end;
  3640. end;
  3641. end;
  3642. if CanReplace then
  3643. begin
  3644. Lock;
  3645. SetSelection(A,B);
  3646. DelSelect;
  3647. InsertText(ReplaceStr);
  3648. if SForward then
  3649. begin
  3650. X:=CurPos.X;
  3651. Y:=CurPos.Y;
  3652. end
  3653. else
  3654. begin
  3655. X:=A.X;
  3656. Y:=A.Y;
  3657. end;
  3658. UnLock;
  3659. end
  3660. else
  3661. begin
  3662. If SForward then
  3663. begin
  3664. X:=B.X;
  3665. Y:=B.Y;
  3666. end
  3667. else
  3668. begin
  3669. X:=A.X;
  3670. Y:=A.Y;
  3671. end;
  3672. end;
  3673. if (DoReplaceAll=false) then
  3674. CanExit:=true;
  3675. end;
  3676. end;
  3677. if (CanExit=false) and (CurDY<>0) then
  3678. begin
  3679. inc(Y,CurDY);
  3680. if SForward then
  3681. X:=0
  3682. else
  3683. X:=254;
  3684. CanExit:=(Y>=Count) or (Y<0);
  3685. end;
  3686. if not CanExit then
  3687. CanExit:=not InArea(X,Y);
  3688. until CanExit;
  3689. if (FoundCount=0) or (DoReplace) then
  3690. SetHighlight(CurPos,CurPos);
  3691. if (DoReplace=false) or ((Confirm=false) and (Owner<>nil)) then
  3692. Owner^.UnLock;
  3693. {if (DoReplace=false) or (Confirm=false) then
  3694. UnLock;}
  3695. if (FoundCount=0) then
  3696. EditorDialog(edSearchFailed,nil);
  3697. if (FindFlags and ffmScope)=ffSelectedText then
  3698. { restore selection PM }
  3699. begin
  3700. SetSelection(AreaStart,AreaEnd);
  3701. end;
  3702. end;
  3703. procedure TCodeEditor.SetInsertMode(InsertMode: boolean);
  3704. begin
  3705. if InsertMode then
  3706. Flags:=(Flags or efInsertMode)
  3707. else
  3708. Flags:=(Flags and (not efInsertMode));
  3709. DrawCursor;
  3710. end;
  3711. procedure TCodeEditor.SetModified(AModified: boolean);
  3712. begin
  3713. if AModified<>Modified then
  3714. begin
  3715. Modified:=AModified;
  3716. ModifiedChanged;
  3717. end;
  3718. end;
  3719. { there is a problem with ShiftDel here
  3720. because GetShitState tells to extend the
  3721. selection which gives wrong results (PM) }
  3722. function TCodeEditor.ShouldExtend: boolean;
  3723. var ShiftInEvent: boolean;
  3724. begin
  3725. ShiftInEvent:=false;
  3726. if Assigned(CurEvent) then
  3727. if CurEvent^.What=evKeyDown then
  3728. ShiftInEvent:=((CurEvent^.KeyShift and kbShift)<>0);
  3729. ShouldExtend:=ShiftInEvent and
  3730. not DontConsiderShiftState;
  3731. end;
  3732. procedure TCodeEditor.SetCurPtr(X,Y: sw_integer);
  3733. var OldPos,OldSEnd,OldSStart: TPoint;
  3734. Extended: boolean;
  3735. begin
  3736. Lock;
  3737. X:=Max(0,Min(MaxLineLength+1,X));
  3738. Y:=Max(0,Min(GetLineCount-1,Y));
  3739. OldPos:=CurPos;
  3740. OldSEnd:=SelEnd;
  3741. OldSStart:=SelStart;
  3742. CurPos.X:=X;
  3743. CurPos.Y:=Y;
  3744. TrackCursor(false);
  3745. if (NoSelect=false) and (ShouldExtend) then
  3746. begin
  3747. CheckSels;
  3748. Extended:=false;
  3749. if PointOfs(OldPos)=PointOfs(SelStart) then
  3750. begin SetSelection(CurPos,SelEnd); Extended:=true; end;
  3751. CheckSels;
  3752. if Extended=false then
  3753. if PointOfs(OldPos)=PointOfs(SelEnd) then
  3754. begin
  3755. if ValidBlock=false then
  3756. SetSelection(CurPos,CurPos);
  3757. SetSelection(SelStart,CurPos); Extended:=true;
  3758. end;
  3759. CheckSels;
  3760. if (Extended=false) then
  3761. if PointOfs(OldPos)<=PointOfs(CurPos)
  3762. then begin SetSelection(OldPos,CurPos); Extended:=true; end
  3763. else begin SetSelection(CurPos,OldPos); Extended:=true; end;
  3764. DrawView;
  3765. end else
  3766. if not IsFlagSet(efPersistentBlocks) then
  3767. begin HideSelect; DrawView; end;
  3768. { if PointOfs(SelStart)=PointOfs(SelEnd) then
  3769. SetSelection(CurPos,CurPos);}
  3770. if (Flags and (efHighlightColumn+efHighlightRow))<>0 then
  3771. DrawView;
  3772. if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) and
  3773. ((Highlight.A.X<>HighLight.B.X) or (Highlight.A.Y<>HighLight.B.Y)) then
  3774. HideHighlight;
  3775. if (OldPos.Y<>CurPos.Y) and (0<=OldPos.Y) and (OldPos.Y<GetLineCount) then
  3776. SetLineText(OldPos.Y,RTrim(GetLineText(OldPos.Y),not IsFlagSet(efUseTabCharacters)));
  3777. if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) and (GetErrorMessage<>'') then
  3778. SetErrorMessage('');
  3779. if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) and (HighlightRow<>-1) then
  3780. SetHighlightRow(-1);
  3781. if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) then
  3782. AddAction(eaMoveCursor,OldPos,CurPos,'');
  3783. if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) then
  3784. UpdateIndicator;
  3785. UnLock;
  3786. end;
  3787. procedure TCodeEditor.CheckSels;
  3788. begin
  3789. if (SelStart.Y>SelEnd.Y) or
  3790. ( (SelStart.Y=SelEnd.Y) and (SelStart.X>SelEnd.X) ) then
  3791. SetSelection(SelEnd,SelStart);
  3792. end;
  3793. procedure TCodeEditor.CodeCompleteApply;
  3794. var S: string;
  3795. I: integer;
  3796. begin
  3797. Lock;
  3798. { here should be some kind or "mark" or "break" inserted in the Undo
  3799. information, so activating it "undoes" only the completition first and
  3800. doesn't delete the complete word at once... - Gabor }
  3801. S:=GetCodeCompleteFrag;
  3802. SetCurPtr(CurPos.X-length(S),CurPos.Y);
  3803. for I:=1 to length(S) do
  3804. DelChar;
  3805. S:=GetCodeCompleteWord;
  3806. for I:=1 to length(S) do
  3807. AddChar(S[I]);
  3808. UnLock;
  3809. SetCompleteState(csInactive);
  3810. end;
  3811. procedure TCodeEditor.CodeCompleteCancel;
  3812. begin
  3813. SetCompleteState(csDenied);
  3814. end;
  3815. procedure TCodeEditor.CodeCompleteCheck;
  3816. var Line: string;
  3817. X,Y,I: sw_integer;
  3818. CurWord,NewWord: string;
  3819. begin
  3820. SetCodeCompleteFrag('');
  3821. if (not IsFlagSet(efCodeComplete)) or (IsReadOnly=true) then Exit;
  3822. Lock;
  3823. Line:=GetDisplayText(CurPos.Y);
  3824. X:=CurPos.X; CurWord:='';
  3825. if X<=length(Line) then
  3826. while (X>0) and (Line[X] in (NumberChars+AlphaChars)) do
  3827. begin
  3828. CurWord:=Line[X]+CurWord;
  3829. Dec(X);
  3830. end;
  3831. if (length(CurWord)>=CodeCompleteMinLen) and CompleteCodeWord(CurWord,NewWord) then
  3832. begin
  3833. SetCodeCompleteFrag(CurWord);
  3834. SetCodeCompleteWord(NewWord);
  3835. end
  3836. else
  3837. ClearCodeCompleteWord;
  3838. UnLock;
  3839. end;
  3840. function TCodeEditor.GetCodeCompleteFrag: string;
  3841. begin
  3842. GetCodeCompleteFrag:=GetStr(CodeCompleteFrag);
  3843. end;
  3844. procedure TCodeEditor.SetCodeCompleteFrag(const S: string);
  3845. begin
  3846. if Assigned(CodeCompleteFrag) then DisposeStr(CodeCompleteFrag);
  3847. CodeCompleteFrag:=NewStr(S);
  3848. end;
  3849. function TCodeEditor.UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer;
  3850. type
  3851. TCharClass = (ccWhiteSpace,ccTab,ccAlpha,ccNumber,ccRealNumber,ccHash,ccSymbol);
  3852. var
  3853. SymbolIndex: Sw_integer;
  3854. CurrentCommentType : Byte;
  3855. FirstCC,LastCC: TCharClass;
  3856. InAsm,InComment,InSingleLineComment,InDirective,InString: boolean;
  3857. X,ClassStart: Sw_integer;
  3858. SymbolConcat: string;
  3859. LineText,Format: string;
  3860. function MatchSymbol(const What, S: string): boolean;
  3861. var Match: boolean;
  3862. begin
  3863. Match:=false;
  3864. if length(What)>=length(S) then
  3865. if copy(What,1+length(What)-length(S),length(S))=S then
  3866. Match:=true;
  3867. MatchSymbol:=Match;
  3868. end;
  3869. var MatchedSymbol: boolean;
  3870. MatchingSymbol: string;
  3871. type TPartialType = (pmNone,pmLeft,pmRight,pmAny);
  3872. function MatchesAnySpecSymbol(What: string; SClass: TSpecSymbolClass; PartialMatch: TPartialType;
  3873. CaseInsensitive: boolean): boolean;
  3874. var S: string;
  3875. I: Sw_integer;
  3876. Match,Found: boolean;
  3877. begin
  3878. Found:=false;
  3879. if CaseInsensitive then
  3880. What:=UpcaseStr(What);
  3881. if What<>'' then
  3882. for I:=1 to GetSpecSymbolCount(SClass) do
  3883. begin
  3884. SymbolIndex:=I;
  3885. S:=GetSpecSymbol(SClass,I-1);
  3886. if (length(What)<length(S)) or
  3887. ((PartialMatch=pmNone) and (length(S)<>length(What)))
  3888. then
  3889. Match:=false
  3890. else
  3891. begin
  3892. if CaseInsensitive then
  3893. S:=UpcaseStr(S);
  3894. case PartialMatch of
  3895. pmNone : Match:=What=S;
  3896. pmRight:
  3897. Match:=copy(What,length(What)-length(S)+1,length(S))=S;
  3898. else Match:=MatchSymbol(What,S);
  3899. end;
  3900. end;
  3901. if Match then
  3902. begin
  3903. MatchingSymbol:=S; Found:=true; Break;
  3904. end;
  3905. end;
  3906. MatchedSymbol:=MatchedSymbol or Found;
  3907. MatchesAnySpecSymbol:=Found;
  3908. end;
  3909. function IsCommentPrefix: boolean;
  3910. begin
  3911. IsCommentPrefix:=MatchesAnySpecSymbol(SymbolConcat,ssCommentPrefix,pmLeft,false);
  3912. end;
  3913. function IsSingleLineCommentPrefix: boolean;
  3914. begin
  3915. IsSingleLineCommentPrefix:=MatchesAnySpecSymbol(SymbolConcat,ssCommentSingleLinePrefix,pmLeft,false);
  3916. end;
  3917. function IsCommentSuffix: boolean;
  3918. begin
  3919. IsCommentSuffix:=(MatchesAnySpecSymbol(SymbolConcat,ssCommentSuffix,pmRight,false))
  3920. and (CurrentCommentType=SymbolIndex);
  3921. end;
  3922. function IsStringPrefix: boolean;
  3923. begin
  3924. IsStringPrefix:=MatchesAnySpecSymbol(SymbolConcat,ssStringPrefix,pmLeft,false);
  3925. end;
  3926. function IsStringSuffix: boolean;
  3927. begin
  3928. IsStringSuffix:=MatchesAnySpecSymbol(SymbolConcat,ssStringSuffix,pmRight,false);
  3929. end;
  3930. function IsDirectivePrefix: boolean;
  3931. begin
  3932. IsDirectivePrefix:=MatchesAnySpecSymbol(SymbolConcat,ssDirectivePrefix,pmLeft,false);
  3933. end;
  3934. function IsDirectiveSuffix: boolean;
  3935. begin
  3936. IsDirectiveSuffix:=MatchesAnySpecSymbol(SymbolConcat,ssDirectiveSuffix,pmRight,false);
  3937. end;
  3938. function IsAsmPrefix(const WordS: string): boolean;
  3939. begin
  3940. IsAsmPrefix:=MatchesAnySpecSymbol(WordS,ssAsmPrefix,pmNone,true);
  3941. end;
  3942. function IsAsmSuffix(const WordS: string): boolean;
  3943. begin
  3944. IsAsmSuffix:=MatchesAnySpecSymbol(WordS,ssAsmSuffix,pmNone,true);
  3945. end;
  3946. function GetCharClass(C: char): TCharClass;
  3947. var CC: TCharClass;
  3948. begin
  3949. if C in WhiteSpaceChars then CC:=ccWhiteSpace else
  3950. if C in TabChars then CC:=ccTab else
  3951. if C in HashChars then CC:=ccHash else
  3952. if C in AlphaChars then CC:=ccAlpha else
  3953. if C in NumberChars then CC:=ccNumber else
  3954. if (LastCC=ccNumber) and (C in RealNumberChars) then
  3955. begin
  3956. if (C='.') then
  3957. begin
  3958. if (LineText[X+1]='.') then
  3959. cc:=ccSymbol
  3960. else
  3961. CC:=ccRealNumber
  3962. end
  3963. else
  3964. cc:=ccrealnumber;
  3965. end else
  3966. CC:=ccSymbol;
  3967. GetCharClass:=CC;
  3968. end;
  3969. procedure FormatWord(SClass: TCharClass; StartX:Sw_integer;EndX: Sw_integer);
  3970. var
  3971. C: byte;
  3972. WordS: string;
  3973. begin
  3974. C:=0;
  3975. WordS:=copy(LineText,StartX,EndX-StartX+1);
  3976. if IsAsmSuffix(WordS) and (InAsm=true) and (InComment=false) and
  3977. (InString=false) and (InDirective=false) then InAsm:=false;
  3978. if InDirective then C:=coDirectiveColor else
  3979. if InComment then C:=coCommentColor else
  3980. if InString then C:=coStringColor else
  3981. if InAsm then C:=coAssemblerColor else
  3982. case SClass of
  3983. ccWhiteSpace : C:=coWhiteSpaceColor;
  3984. ccTab : C:=coTabColor;
  3985. ccNumber :
  3986. if copy(WordS,1,1)='$' then
  3987. C:=coHexNumberColor
  3988. else
  3989. C:=coNumberColor;
  3990. ccHash :
  3991. C:=coStringColor;
  3992. ccSymbol :
  3993. C:=coSymbolColor;
  3994. ccAlpha :
  3995. begin
  3996. if IsReservedWord(WordS) then
  3997. C:=coReservedWordColor
  3998. else
  3999. C:=coIdentifierColor;
  4000. end;
  4001. end;
  4002. if EndX+1>=StartX then
  4003. FillChar(Format[StartX],EndX+1-StartX,C);
  4004. if IsAsmPrefix(WordS) and
  4005. (InAsm=false) and (InComment=false) and (InDirective=false) then
  4006. InAsm:=true;
  4007. end;
  4008. procedure ProcessChar(C: char);
  4009. var CC: TCharClass;
  4010. EX: Sw_integer;
  4011. begin
  4012. CC:=GetCharClass(C);
  4013. if ClassStart=X then
  4014. FirstCC:=CC;
  4015. if ( (CC<>LastCC) and
  4016. (
  4017. ((FirstCC=ccNumber) and (CC<>ccRealNumber)) or
  4018. (((CC<>ccAlpha) or (LastCC<>ccNumber) ) and
  4019. ( (CC<>ccNumber) or (LastCC<>ccAlpha) ) and
  4020. ( (CC<>ccNumber) or (LastCC<>ccHash) ) and
  4021. ( (CC<>ccRealNumber) or (LastCC<>ccNumber))
  4022. ))) or
  4023. (X>length(LineText)) or (CC=ccSymbol) then
  4024. begin
  4025. MatchedSymbol:=false;
  4026. EX:=X-1;
  4027. if (CC=ccSymbol) then
  4028. begin
  4029. if length(SymbolConcat)>=High(SymbolConcat) then
  4030. Delete(SymbolConcat,1,1);
  4031. SymbolConcat:=SymbolConcat+C;
  4032. end;
  4033. case CC of
  4034. ccSymbol :
  4035. if IsCommentSuffix and (InComment) then
  4036. Inc(EX) else
  4037. if IsStringSuffix and (InString) then
  4038. Inc(EX) else
  4039. if IsDirectiveSuffix and (InDirective) then
  4040. Inc(EX);
  4041. end;
  4042. if (C='$') and (MatchedSymbol=false) and (IsDirectivePrefix=false) then
  4043. CC:=ccNumber;
  4044. if CC<>ccSymbol then SymbolConcat:='';
  4045. FormatWord(LastCC,ClassStart,EX);
  4046. ClassStart:=EX+1;
  4047. case CC of
  4048. ccAlpha : ;
  4049. ccNumber :
  4050. if (LastCC<>ccAlpha) then;
  4051. ccSymbol :
  4052. if IsDirectivePrefix and {(InComment=false) and }(InDirective=false) then
  4053. begin InDirective:=true; InComment:=false; Dec(ClassStart,length(MatchingSymbol)-1); end else
  4054. if IsDirectiveSuffix and (InComment=false) and (InDirective=true) then
  4055. InDirective:=false else
  4056. if IsCommentPrefix and (InComment=false) and (InString=false) then
  4057. begin
  4058. InComment:=true;
  4059. CurrentCommentType:=SymbolIndex;
  4060. InSingleLineComment:=IsSingleLineCommentPrefix;
  4061. {InString:=false; }
  4062. Dec(ClassStart,length(MatchingSymbol)-1);
  4063. end
  4064. else
  4065. if IsCommentSuffix and (InComment) then
  4066. begin InComment:=false; InString:=false; end else
  4067. if IsStringPrefix and (InComment=false) and (InString=false) then
  4068. begin InString:=true; Dec(ClassStart,length(MatchingSymbol)-1); end else
  4069. if IsStringSuffix and (InComment=false) and (InString=true) then
  4070. InString:=false;
  4071. end;
  4072. if MatchedSymbol and (InComment=false) then
  4073. SymbolConcat:='';
  4074. LastCC:=CC;
  4075. end;
  4076. end;
  4077. var CurLine: Sw_integer;
  4078. Line,NextLine,PrevLine,OldLine: PLine;
  4079. begin
  4080. if (not IsFlagSet(efSyntaxHighlight)) or (FromLine>=GetLineCount) then
  4081. begin
  4082. SetLineFormat(FromLine,'');
  4083. UpdateAttrs:=GetLineCount;
  4084. {$ifdef TEST_PARTIAL_SYNTAX}
  4085. LastSyntaxedLine:=GetLineCount;
  4086. SyntaxComplete:=true;
  4087. { no Idle necessary }
  4088. EventMask:=EventMask and not evIdle;
  4089. {$endif TEST_PARTIAL_SYNTAX}
  4090. UpdateIndicator;
  4091. Exit;
  4092. end;
  4093. {$ifdef TEST_PARTIAL_SYNTAX}
  4094. If IsFlagSet(efSyntaxHighlight) and (LastSyntaxedLine<FromLine)
  4095. and (FromLine<GetLineCount) then
  4096. CurLine:=LastSyntaxedLine
  4097. else
  4098. {$endif TEST_PARTIAL_SYNTAX}
  4099. CurLine:=FromLine;
  4100. if CurLine>0 then PrevLine:=Lines^.At(CurLine-1) else PrevLine:=nil;
  4101. repeat
  4102. Line:=Lines^.At(CurLine);
  4103. InSingleLineComment:=false;
  4104. if PrevLine<>nil then
  4105. begin
  4106. InAsm:=PrevLine^.EndsWithAsm;
  4107. InComment:=PrevLine^.EndsWithComment and not PrevLine^.EndsInSingleLineComment;
  4108. CurrentCommentType:=PrevLine^.EndCommentType;
  4109. InDirective:=PrevLine^.EndsWithDirective;
  4110. end
  4111. else
  4112. begin
  4113. InAsm:=false;
  4114. InComment:=false;
  4115. CurrentCommentType:=0;
  4116. InDirective:=false;
  4117. end;
  4118. OldLine:=Line;
  4119. Line^.BeginsWithAsm:=InAsm;
  4120. Line^.BeginsWithComment:=InComment;
  4121. Line^.BeginsWithDirective:=InDirective;
  4122. Line^.BeginCommentType:=CurrentCommentType;
  4123. LineText:=GetLineText(CurLine);
  4124. Format:=CharStr(chr(coTextColor),length(LineText));
  4125. LastCC:=ccWhiteSpace;
  4126. ClassStart:=1;
  4127. SymbolConcat:='';
  4128. InString:=false;
  4129. if LineText<>'' then
  4130. begin
  4131. for X:=1 to length(LineText) do
  4132. ProcessChar(LineText[X]);
  4133. Inc(X);
  4134. ProcessChar(' ');
  4135. end;
  4136. SetLineFormat(CurLine,Format);
  4137. Line^.EndsWithAsm:=InAsm;
  4138. Line^.EndsWithComment:=InComment;
  4139. Line^.EndsInSingleLineComment:=InSingleLineComment;
  4140. Line^.EndCommentType:=CurrentCommentType;
  4141. Line^.EndsWithDirective:=InDirective;
  4142. Inc(CurLine);
  4143. if CurLine>=GetLineCount then
  4144. Break;
  4145. NextLine:=Lines^.At(CurLine);
  4146. if ((Attrs and attrForceFull)=0) then
  4147. if { Why should we go
  4148. (InAsm=false) and (NextLine^.BeginsWithAsm=false) and
  4149. (InComment=false) and (NextLine^.BeginsWithComment=false) and
  4150. (InDirective=false) and (NextLine^.BeginsWithDirective=false) and
  4151. OldLine = Line so this is nonsense
  4152. (OldLine^.EndsWithComment=Line^.EndsWithComment) and
  4153. (OldLine^.EndsWithAsm=Line^.EndsWithAsm) and
  4154. (OldLine^.EndsWithDirective=Line^.EndsWithDirective) and }
  4155. {$ifdef TEST_PARTIAL_SYNTAX}
  4156. (CurLine>FromLine) and
  4157. {$endif TEST_PARTIAL_SYNTAX}
  4158. (NextLine^.BeginsWithAsm=Line^.EndsWithAsm) and
  4159. (NextLine^.BeginsWithComment=Line^.EndsWithComment) and
  4160. (NextLine^.BeginsWithDirective=Line^.EndsWithDirective) and
  4161. (NextLine^.BeginCommentType=Line^.EndCommentType) and
  4162. (NextLine^.Format<>nil) then
  4163. Break;
  4164. {$ifdef TEST_PARTIAL_SYNTAX}
  4165. if (CurLine<GetLineCount) and
  4166. (CurLine>FromLine) and
  4167. ((Attrs and attrForceFull)=0) and
  4168. (CurLine>Delta.Y+Size.Y) then
  4169. begin
  4170. If SyntaxComplete then
  4171. begin
  4172. SyntaxComplete:=false;
  4173. { no Idle necessary }
  4174. EventMask:=EventMask or evIdle;
  4175. UpdateIndicator;
  4176. end;
  4177. LastSyntaxedLine:=CurLine-1;
  4178. break;
  4179. end;
  4180. {$endif TEST_PARTIAL_SYNTAX}
  4181. PrevLine:=Line;
  4182. until false;
  4183. UpdateAttrs:=CurLine;
  4184. {$ifdef TEST_PARTIAL_SYNTAX}
  4185. If LastSyntaxedLine<CurLine-1 then
  4186. LastSyntaxedLine:=CurLine-1;
  4187. if CurLine=GetLineCount then
  4188. begin
  4189. SyntaxComplete:=true;
  4190. { no Idle necessary }
  4191. EventMask:=EventMask and not evIdle;
  4192. UpdateIndicator;
  4193. end;
  4194. {$endif TEST_PARTIAL_SYNTAX}
  4195. end;
  4196. function TCodeEditor.UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer;
  4197. var Line: Sw_integer;
  4198. begin
  4199. Lock;
  4200. Line:=FromLine;
  4201. repeat
  4202. Line:=UpdateAttrs(Line,Attrs);
  4203. until (Line>=GetLineCount) or (Line>ToLine);
  4204. UpdateAttrsRange:=Line;
  4205. Unlock;
  4206. end;
  4207. procedure TCodeEditor.DrawLines(FirstLine: sw_integer);
  4208. begin
  4209. if FirstLine>=(Delta.Y+Size.Y) then Exit; { falls outside of the screen }
  4210. DrawView;
  4211. end;
  4212. function TCodeEditor.InsertText(const S: string): Boolean;
  4213. var I: sw_integer;
  4214. OldPos: TPoint;
  4215. HoldUndo : boolean;
  4216. begin
  4217. Lock;
  4218. OldPos:=CurPos;
  4219. HoldUndo:=StoreUndo;
  4220. StoreUndo:=false;
  4221. for I:=1 to length(S) do
  4222. AddChar(S[I]);
  4223. InsertText:=true;
  4224. StoreUndo:=HoldUndo;
  4225. AddAction(eaInsertText,OldPos,CurPos,S);
  4226. UnLock;
  4227. end;
  4228. function TCodeEditor.InsertFrom(Editor: PCodeEditor): Boolean;
  4229. var OK: boolean;
  4230. LineDelta,LineCount: Sw_integer;
  4231. StartPos,DestPos,BPos,EPos: TPoint;
  4232. LineStartX,LineEndX: Sw_integer;
  4233. S,OrigS,AfterS: string;
  4234. VerticalBlock: boolean;
  4235. SEnd: TPoint;
  4236. begin
  4237. if Editor^.IsFlagSet(efVerticalBlocks) then
  4238. begin
  4239. NotImplemented;
  4240. Exit;
  4241. end;
  4242. Lock;
  4243. { every data in the clipboard gets a new line }
  4244. if (Clipboard=@Self) and (CurPos.X>0) then
  4245. InsertLine;
  4246. OK:=(Editor^.SelStart.X<>Editor^.SelEnd.X) or (Editor^.SelStart.Y<>Editor^.SelEnd.Y);
  4247. if OK then
  4248. begin
  4249. StartPos:=CurPos; DestPos:=CurPos;
  4250. EPos:=CurPos;
  4251. VerticalBlock:=Editor^.IsFlagSet(efVerticalBlocks);
  4252. LineDelta:=0; LineCount:=(Editor^.SelEnd.Y-Editor^.SelStart.Y)+1;
  4253. OK:=GetLineCount<MaxLineCount;
  4254. OrigS:=GetDisplayText(DestPos.Y);
  4255. AfterS:=Copy(OrigS,DestPos.X+1,255);
  4256. while OK and (LineDelta<LineCount) do
  4257. begin
  4258. if (LineDelta>0) and (VerticalBlock=false) then
  4259. begin
  4260. Lines^.AtInsert(DestPos.Y,NewLine(''));
  4261. BPos.X:=0;BPos.Y:=DestPos.Y;
  4262. EPOS.X:=0;EPos.Y:=DestPos.Y;
  4263. AddAction(eaInsertLine,BPos,EPos,'');
  4264. LimitsChanged;
  4265. end;
  4266. if (LineDelta=0) or VerticalBlock then
  4267. LineStartX:=Editor^.SelStart.X
  4268. else
  4269. LineStartX:=0;
  4270. if (LineDelta=LineCount-1) or VerticalBlock then
  4271. LineEndX:=Editor^.SelEnd.X-1
  4272. else
  4273. LineEndX:=255;
  4274. if LineEndX<LineStartX then
  4275. S:=''
  4276. else if VerticalBlock then
  4277. S:=RExpand(copy(Editor^.GetLineText(Editor^.SelStart.Y+LineDelta),LineStartX+1,LineEndX-LineStartX+1),
  4278. Min(LineEndX-LineStartX+1,255))
  4279. else
  4280. S:=copy(Editor^.GetLineText(Editor^.SelStart.Y+LineDelta),LineStartX+1,LineEndX-LineStartX+1);
  4281. if VerticalBlock=false then
  4282. begin
  4283. If LineDelta>0 then
  4284. OrigS:='';
  4285. if LineDelta=LineCount-1 then
  4286. begin
  4287. SetLineText(DestPos.Y,RExpand(copy(OrigS,1,DestPos.X),DestPos.X)+S+AfterS);
  4288. BPos.X:=DestPos.X;BPos.Y:=DestPos.Y;
  4289. EPOS.X:=DestPos.X+Length(S);EPos.Y:=DestPos.Y;
  4290. AddAction(eaInsertText,BPos,EPos,S);
  4291. end
  4292. else
  4293. begin
  4294. SetLineText(DestPos.Y,RExpand(copy(OrigS,1,DestPos.X),DestPos.X)+S);
  4295. BPos.X:=DestPos.X;BPos.Y:=DestPos.Y;
  4296. EPOS.X:=DestPos.X+Length(S);EPos.Y:=DestPos.Y;
  4297. AddAction(eaInsertText,BPos,EPos,S);
  4298. end;
  4299. if LineDelta=LineCount-1 then
  4300. begin
  4301. SEnd.Y:=DestPos.Y;
  4302. SEnd.X:=DestPos.X+length(S);
  4303. end
  4304. else
  4305. begin
  4306. Inc(DestPos.Y);
  4307. DestPos.X:=0;
  4308. end;
  4309. end
  4310. else { if VerticalBlock=false then .. else }
  4311. begin
  4312. { this is not yet implemented !! PM }
  4313. S:=RExpand(S,LineEndX-LineStartX+1);
  4314. end;
  4315. Inc(LineDelta);
  4316. OK:=GetLineCount<MaxLineCount;
  4317. end;
  4318. if OK=false then EditorDialog(edTooManyLines,nil);
  4319. { mainly to force eaMove insertion }
  4320. if not IsClipboard then
  4321. SetCurPtr(EPos.X,EPos.Y);
  4322. SetCurPtr(StartPos.X,StartPos.Y);
  4323. UpdateAttrs(StartPos.Y,attrAll);
  4324. SetModified(true);
  4325. LimitsChanged;
  4326. SetSelection(CurPos,SEnd);
  4327. if IsClipboard then
  4328. begin
  4329. Inc(DestPos.X,length(S));
  4330. SetCurPtr(DestPos.X,DestPos.Y);
  4331. end;
  4332. DrawView;
  4333. end;
  4334. UnLock;
  4335. InsertFrom:=OK;
  4336. end;
  4337. function TCodeEditor.IsClipboard: Boolean;
  4338. begin
  4339. IsClipboard:=(Clipboard=@Self);
  4340. end;
  4341. procedure TCodeEditor.HideHighlight;
  4342. begin
  4343. SetHighlight(CurPos,CurPos);
  4344. end;
  4345. procedure TCodeEditor.AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: string);
  4346. {$ifdef Undo}
  4347. var
  4348. ActionIntegrated : boolean;
  4349. pa : PEditorAction;
  4350. S : String;
  4351. {$endif Undo}
  4352. begin
  4353. {$ifdef Undo}
  4354. if (UndoList=nil) or (not StoreUndo) then Exit;
  4355. ActionIntegrated:=false;
  4356. if UndoList^.count>0 then
  4357. begin
  4358. pa:=UndoList^.At(UndoList^.count-1);
  4359. if (pa^.action=AAction) and
  4360. (pa^.EndPos.X=AStartPos.X) and
  4361. (pa^.EndPos.Y=AStartPos.Y) and
  4362. { do not group InsertLine and DeleteLine !! }
  4363. ((AAction=eaMoveCursor) or
  4364. (AAction=eaInsertText) or
  4365. (AAction=eaDeleteText))
  4366. then
  4367. begin
  4368. pa^.EndPos:=AEndPos;
  4369. S:=GetStr(pa^.text);
  4370. if S<>'' then
  4371. DisposeStr(pa^.text);
  4372. if (AAction=eaDeleteText) and
  4373. (AStartPos.X>AEndPos.X) then
  4374. pa^.text:=NewStr(AText+S)
  4375. else
  4376. pa^.text:=NewStr(S+AText);
  4377. ActionIntegrated:=true;
  4378. end;
  4379. end;
  4380. if not ActionIntegrated then
  4381. begin
  4382. UndoList^.Insert(New(PEditorAction,Init(AAction,AStartPos,AEndPos,AText)));
  4383. if assigned(UndoList^.CurrentGroupedAction) then
  4384. Inc(UndoList^.CurrentGroupedAction^.actionCount);
  4385. UpdateUndoRedo(cmUndo,AAction);
  4386. end;
  4387. if UndoList^.count>0 then
  4388. begin
  4389. SetCmdState(UndoCmd,true);
  4390. SetCmdState(RedoCmd,false);
  4391. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  4392. UpdateUndoRedo(cmRedo,0);
  4393. RedoList^.FreeAll;
  4394. end;
  4395. {$endif Undo}
  4396. end;
  4397. procedure TCodeEditor.AddGroupedAction(AAction : byte);
  4398. begin
  4399. {$ifdef Undo}
  4400. UndoList^.CurrentGroupedAction:=New(PEditorAction,Init_group(AAction));
  4401. {$endif Undo}
  4402. end;
  4403. procedure TCodeEditor.CloseGroupedAction(AAction : byte);
  4404. begin
  4405. {$ifdef Undo}
  4406. UndoList^.Insert(UndoList^.CurrentGroupedAction);
  4407. UndoList^.CurrentGroupedAction:=nil;
  4408. UpdateUndoRedo(cmUndo,AAction);
  4409. {$endif Undo}
  4410. end;
  4411. function TCodeEditor.ValidBlock: boolean;
  4412. begin
  4413. ValidBlock:=(SelStart.X<>SelEnd.X) or (SelStart.Y<>SelEnd.Y);
  4414. end;
  4415. procedure TCodeEditor.SetSelection(A, B: TPoint);
  4416. var WV: boolean;
  4417. OS,OE: TPoint;
  4418. begin
  4419. WV:=ValidBlock;
  4420. OS:=SelStart; OE:=SelEnd;
  4421. SelStart:=A; SelEnd:=B;
  4422. if (WV=false) and (ValidBlock=false) then { do nothing } else
  4423. if (OS.X<>SelStart.X) or (OS.Y<>SelStart.Y) or
  4424. (OE.X<>SelEnd.X) or (OE.Y<>SelEnd.Y) then
  4425. SelectionChanged;
  4426. end;
  4427. procedure TCodeEditor.SetHighlight(A, B: TPoint);
  4428. begin
  4429. Highlight.A:=A; Highlight.B:=B;
  4430. HighlightChanged;
  4431. end;
  4432. procedure TCodeEditor.SetHighlightRow(Row: sw_integer);
  4433. begin
  4434. HighlightRow:=Row;
  4435. DrawView;
  4436. end;
  4437. procedure TCodeEditor.SetDebuggerRow(Row: sw_integer);
  4438. begin
  4439. DebuggerRow:=Row;
  4440. DrawView;
  4441. end;
  4442. procedure TCodeEditor.SetCompleteState(AState: TCompleteState);
  4443. begin
  4444. if AState<>CompleteState then
  4445. begin
  4446. CompleteState:=AState;
  4447. if CompleteState<>csOffering then
  4448. ClearCodeCompleteWord;
  4449. end;
  4450. end;
  4451. procedure TCodeEditor.SelectAll(Enable: boolean);
  4452. var A,B: TPoint;
  4453. begin
  4454. if (Enable=false) or (GetLineCount=0) then
  4455. begin A:=CurPos; B:=CurPos end
  4456. else
  4457. begin
  4458. A.X:=0; A.Y:=0;
  4459. { B.Y:=GetLineCount-1;
  4460. B.X:=length(GetLineText(B.Y));}
  4461. B.Y:=GetLineCount; B.X:=0;
  4462. end;
  4463. SetSelection(A,B);
  4464. DrawView;
  4465. end;
  4466. procedure TCodeEditor.SelectionChanged;
  4467. var Enable,CanPaste: boolean;
  4468. begin
  4469. if GetLineCount=0 then
  4470. begin
  4471. SelStart.X:=0; SelStart.Y:=0; SelEnd:=SelStart;
  4472. end
  4473. else
  4474. if SelEnd.Y>GetLineCount-1 then
  4475. if (SelEnd.Y<>GetLineCount) or (SelEnd.X<>0) then
  4476. begin
  4477. SelEnd.Y:=GetLineCount-1;
  4478. SelEnd.X:=length(GetDisplayText(SelEnd.Y));
  4479. end;
  4480. Enable:=((SelStart.X<>SelEnd.X) or (SelStart.Y<>SelEnd.Y)) and (Clipboard<>nil);
  4481. SetCmdState(ToClipCmds,Enable and (Clipboard<>@Self));
  4482. SetCmdState(NulClipCmds,Enable);
  4483. CanPaste:=(Clipboard<>nil) and ((Clipboard^.SelStart.X<>Clipboard^.SelEnd.X) or
  4484. (Clipboard^.SelStart.Y<>Clipboard^.SelEnd.Y));
  4485. SetCmdState(FromClipCmds,CanPaste and (Clipboard<>@Self));
  4486. {$ifdef WinClipSupported}
  4487. SetCmdState(FromWinClipCmds,GetTextWinClipboardSize>0);
  4488. {$endif WinClipSupported}
  4489. SetCmdState(UndoCmd,(UndoList^.count>0));
  4490. SetCmdState(RedoCmd,(RedoList^.count>0));
  4491. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  4492. DrawView;
  4493. end;
  4494. procedure TCodeEditor.HighlightChanged;
  4495. begin
  4496. DrawView;
  4497. end;
  4498. procedure TCodeEditor.ModifiedChanged;
  4499. begin
  4500. UpdateIndicator;
  4501. end;
  4502. procedure TCodeEditor.SetState(AState: Word; Enable: Boolean);
  4503. procedure ShowSBar(SBar: PScrollBar);
  4504. begin
  4505. if Assigned(SBar) and (SBar^.GetState(sfVisible)=false) then
  4506. SBar^.Show;
  4507. end;
  4508. begin
  4509. inherited SetState(AState,Enable);
  4510. if AlwaysShowScrollBars then
  4511. begin
  4512. ShowSBar(HScrollBar);
  4513. ShowSBar(VScrollBar);
  4514. end;
  4515. if (AState and (sfActive+sfSelected+sfFocused))<>0 then
  4516. begin
  4517. SelectionChanged;
  4518. if ((State and sfFocused)=0) and (CompleteState=csOffering) then
  4519. ClearCodeCompleteWord;
  4520. end;
  4521. end;
  4522. function TCodeEditor.GetPalette: PPalette;
  4523. const P: string[length(CEditor)] = CEditor;
  4524. begin
  4525. GetPalette:=@P;
  4526. end;
  4527. constructor TCodeEditor.Load(var S: TStream);
  4528. var TS: PSubStream;
  4529. TSize: longint;
  4530. begin
  4531. inherited Load(S);
  4532. New(UndoList,init(500,1000));
  4533. New(RedoList,init(500,1000));
  4534. New(Lines, Init(500,1000));
  4535. { we have always need at least 1 line }
  4536. Lines^.Insert(NewLine(''));
  4537. GetPeerViewPtr(S,Indicator);
  4538. S.Read(Flags,SizeOf(Flags));
  4539. S.Read(TabSize,SizeOf(TabSize));
  4540. if IsFlagSet(efStoreContent) then
  4541. begin
  4542. S.Read(TSize,SizeOf(TSize));
  4543. New(TS, Init(@S,S.GetPos,TSize));
  4544. {$ifdef TEST_PARTIAL_SYNTAX}
  4545. SyntaxComplete:=false;
  4546. { Idle necessary }
  4547. EventMask:=EventMask or evIdle;
  4548. {$endif TEST_PARTIAL_SYNTAX}
  4549. LoadFromStream(TS);
  4550. Dispose(TS, Done);
  4551. end;
  4552. S.Read(SelStart,SizeOf(SelStart));
  4553. S.Read(SelEnd,SizeOf(SelEnd));
  4554. S.Read(Highlight,SizeOf(Highlight));
  4555. S.Read(CurPos,SizeOf(CurPos));
  4556. S.Read(StoreUndo,SizeOf(StoreUndo));
  4557. S.Read(IsReadOnly,SizeOf(IsReadOnly));
  4558. S.Read(NoSelect,SizeOf(NoSelect));
  4559. S.Read(HighlightRow,SizeOf(HighlightRow));
  4560. SetDebuggerRow(-1);
  4561. LimitsChanged;
  4562. SelectionChanged; HighlightChanged;
  4563. UpdateIndicator;
  4564. end;
  4565. procedure TCodeEditor.Store(var S: TStream);
  4566. var {NS: TNulStream;}
  4567. TSizePos,TSize,EndPos: longint;
  4568. begin
  4569. inherited Store(S);
  4570. PutPeerViewPtr(S,Indicator);
  4571. S.Write(Flags,SizeOf(Flags));
  4572. S.Write(TabSize,SizeOf(TabSize));
  4573. if IsFlagSet(efStoreContent) then
  4574. begin
  4575. { NS.Init;
  4576. SaveToStream(@NS);
  4577. TSize:=NS.GetSize;
  4578. NS.Done;
  4579. This is waste of time PM
  4580. use Seek instead !! }
  4581. { yep. and this won't work for serial streams. - Gabor }
  4582. TSize:=0;
  4583. TSizePos:=S.GetPos;
  4584. S.Write(TSize,SizeOf(TSize));
  4585. SaveToStream(@S);
  4586. EndPos:=S.GetPos;
  4587. TSize:=EndPos-TSizePos-SizeOf(TSize);
  4588. S.Seek(TSizePos);
  4589. S.Write(TSize,SizeOf(TSize));
  4590. S.Seek(EndPos);
  4591. end;
  4592. S.Write(SelStart,SizeOf(SelStart));
  4593. S.Write(SelEnd,SizeOf(SelEnd));
  4594. S.Write(Highlight,SizeOf(Highlight));
  4595. S.Write(CurPos,SizeOf(CurPos));
  4596. S.Write(StoreUndo,SizeOf(StoreUndo));
  4597. S.Write(IsReadOnly,SizeOf(IsReadOnly));
  4598. S.Write(NoSelect,SizeOf(NoSelect));
  4599. S.Write(HighlightRow,SizeOf(HighlightRow));
  4600. end;
  4601. function TCodeEditor.LoadFromStream(Stream: PStream): boolean;
  4602. var S: string;
  4603. AllLinesComplete,LineComplete,OK: boolean;
  4604. begin
  4605. DeleteAllLines;
  4606. ChangedLine:=-1;
  4607. AllLinesComplete:=true;
  4608. OK:=(Stream^.Status=stOK);
  4609. if eofstream(Stream) then
  4610. AddLine('')
  4611. else
  4612. while OK and (eofstream(Stream)=false) and (GetLineCount<MaxLineCount) do
  4613. begin
  4614. ReadlnFromStream(Stream,S,LineComplete);
  4615. AllLinesComplete:=AllLinesComplete and LineComplete;
  4616. OK:=OK and (Stream^.Status=stOK);
  4617. if OK then AddLine(S);
  4618. if not LineComplete and (ChangedLine=-1) then
  4619. ChangedLine:=GetLineCount;
  4620. end;
  4621. LimitsChanged;
  4622. if not AllLinesComplete then
  4623. SetModified(true);
  4624. if IsFlagSet(efSyntaxHighlight) then
  4625. UpdateAttrsRange(0,Min(Delta.Y+Size.Y,GetLineCount-1),
  4626. attrAll
  4627. {$ifndef TEST_PARTIAL_SYNTAX}
  4628. +attrForceFull
  4629. {$endif TEST_PARTIAL_SYNTAX}
  4630. );
  4631. TextStart;
  4632. LoadFromStream:=OK;
  4633. end;
  4634. function TCodeEditor.SaveToStream(Stream: PStream): boolean;
  4635. var A,B: TPoint;
  4636. begin
  4637. A.Y:=0; A.X:=0;
  4638. B.Y:=GetLineCount-1;
  4639. if GetLineCount>0 then
  4640. B.X:=length(GetDisplayText(B.Y))
  4641. else
  4642. B.X:=0;
  4643. SaveToStream:=SaveAreaToStream(Stream,A,B);
  4644. end;
  4645. function TCodeEditor.SaveAreaToStream(Stream: PStream; StartP,EndP: TPoint): boolean;
  4646. var S: string;
  4647. OK: boolean;
  4648. Line: Sw_integer;
  4649. P: PLine;
  4650. begin
  4651. if EndP.X=0 then
  4652. begin
  4653. if EndP.Y>0 then
  4654. begin
  4655. EndP.X:=length(GetDisplayText(EndP.Y));
  4656. end
  4657. else
  4658. EndP.X:=0;
  4659. end
  4660. else
  4661. Dec(EndP.X);
  4662. OK:=(Stream^.Status=stOK); Line:=StartP.Y;
  4663. while OK and (Line<=EndP.Y) and (Line<GetLineCount) do
  4664. begin
  4665. P:=Lines^.At(Line);
  4666. if P^.Text=nil then S:='' else
  4667. begin
  4668. S:=P^.Text^;
  4669. if Line=EndP.Y then S:=copy(S,1,LinePosToCharIdx(Line,EndP.X));
  4670. if Line=StartP.Y then S:=copy(S,LinePosToCharIdx(Line,StartP.X),255);
  4671. end;
  4672. { Remove all traling spaces PM }
  4673. if not IsFlagSet(efKeepTrailingSpaces) then
  4674. While (Length(S)>0) and (S[Length(S)]=' ') do
  4675. Dec(S[0]);
  4676. { if FlagSet(efUseTabCharacters) then
  4677. S:=CompressUsingTabs(S,TabSize);
  4678. }
  4679. Stream^.Write(S[1],length(S));
  4680. if Line<EndP.Y then
  4681. Stream^.Write(EOL[1],length(EOL));
  4682. Inc(Line);
  4683. OK:=OK and (Stream^.Status=stOK);
  4684. end;
  4685. SaveAreaToStream:=OK;
  4686. end;
  4687. destructor TCodeEditor.Done;
  4688. begin
  4689. inherited Done;
  4690. if assigned(Lines) then
  4691. Dispose(Lines, Done);
  4692. If assigned(RedoList) then
  4693. Dispose(RedoList,done);
  4694. If assigned(UndoList) then
  4695. Dispose(UndoList,done);
  4696. if Assigned(CodeCompleteFrag) then
  4697. DisposeStr(CodeCompleteFrag);
  4698. if Assigned(CodeCompleteWord) then
  4699. DisposeStr(CodeCompleteWord);
  4700. end;
  4701. {$ifdef Undo}
  4702. constructor TEditorAction.init(act:byte; StartP,EndP:TPoint;Txt:String);
  4703. begin
  4704. Action:=act;
  4705. StartPos:=StartP;
  4706. EndPos:=EndP;
  4707. Text:=NewStr(txt);
  4708. ActionCount:=0;
  4709. end;
  4710. constructor TEditorAction.init_group(act:byte);
  4711. begin
  4712. Action:=act;
  4713. ActionCount:=0;
  4714. end;
  4715. function TEditorAction.Is_grouped_action : boolean;
  4716. begin
  4717. Is_grouped_action:=Action in [eaCut,eaPaste,eaPasteWin,eaClear];
  4718. end;
  4719. destructor TEditorAction.done;
  4720. begin
  4721. DisposeStr(Text);
  4722. end;
  4723. {$else}
  4724. procedure TEditorActionCollection.FreeItem(Item: Pointer);
  4725. begin
  4726. if assigned(Item) then
  4727. freemem(Item,Sizeof(TEditorAction));
  4728. end;
  4729. {$endif Undo}
  4730. function TEditorActionCollection.At(Idx : sw_integer) : PEditorAction;
  4731. begin
  4732. At:=PEditorAction(Inherited At(Idx));
  4733. end;
  4734. constructor TFileEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  4735. PScrollBar; AIndicator: PIndicator;const AFileName: string);
  4736. begin
  4737. inherited Init(Bounds,AHScrollBAr,AVScrollBAr,AIndicator,0);
  4738. FileName:=AFileName;
  4739. UpdateIndicator;
  4740. Message(@Self,evBroadcast,cmFileNameChanged,@Self);
  4741. OnDiskLoadTime:=-1;
  4742. end;
  4743. function TFileEditor.LoadFile: boolean;
  4744. var S: PBufStream;
  4745. OK: boolean;
  4746. begin
  4747. New(S, Init(GetShortName(FileName),stOpenRead,EditorTextBufSize));
  4748. OK:=Assigned(S);
  4749. {$ifdef TEST_PARTIAL_SYNTAX}
  4750. SyntaxComplete:=false;
  4751. { Idle necessary }
  4752. EventMask:=EventMask or evIdle;
  4753. {$endif TEST_PARTIAL_SYNTAX}
  4754. if OK then OK:=LoadFromStream(S);
  4755. if Assigned(S) then Dispose(S, Done);
  4756. OnDiskLoadTime:=GetFileTime(FileName);
  4757. LoadFile:=OK;
  4758. end;
  4759. function TFileEditor.IsChangedOnDisk : boolean;
  4760. begin
  4761. IsChangedOnDisk:=(OnDiskLoadTime<>GetFileTime(FileName)) and (OnDiskLoadTime<>-1);
  4762. end;
  4763. function TFileEditor.SaveFile: boolean;
  4764. var OK: boolean;
  4765. BAKName: string;
  4766. S: PBufStream;
  4767. f: text;
  4768. begin
  4769. If IsChangedOnDisk then
  4770. begin
  4771. if EditorDialog(edFileOnDiskChanged, @FileName) <> cmYes then
  4772. begin
  4773. SaveFile:=false;
  4774. exit;
  4775. end;
  4776. end;
  4777. {$I-}
  4778. if IsFlagSet(efBackupFiles) then
  4779. begin
  4780. BAKName:=DirAndNameOf(FileName)+'.bak';
  4781. Assign(f,BAKName);
  4782. Erase(f);
  4783. EatIO;
  4784. Assign(f,FileName);
  4785. Rename(F,BAKName);
  4786. EatIO;
  4787. end;
  4788. {$I+}
  4789. New(S, Init(FileName,stCreate,EditorTextBufSize));
  4790. OK:=Assigned(S);
  4791. if OK then OK:=SaveToStream(S);
  4792. if Assigned(S) then Dispose(S, Done);
  4793. if OK then SetModified(false);
  4794. { don't forget to update the OnDiskLoadTime value }
  4795. OnDiskLoadTime:=GetFileTime(FileName);
  4796. SaveFile:=OK;
  4797. end;
  4798. function TFileEditor.ShouldSave: boolean;
  4799. begin
  4800. ShouldSave:=Modified{ or (FileName='')};
  4801. end;
  4802. function TFileEditor.Save: Boolean;
  4803. begin
  4804. if ShouldSave=false then begin Save:=true; Exit; end;
  4805. if FileName = '' then Save := SaveAs else Save := SaveFile;
  4806. end;
  4807. function TFileEditor.SaveAs: Boolean;
  4808. begin
  4809. SaveAs := False;
  4810. if EditorDialog(edSaveAs, @FileName) <> cmCancel then
  4811. begin
  4812. FileName := FExpand(FileName);
  4813. Message(Owner, evBroadcast, cmUpdateTitle, @Self);
  4814. { if we rename the file the OnDiskLoadTime is wrong so we reset it }
  4815. OnDiskLoadTime:=-1;
  4816. SaveAs := SaveFile;
  4817. if IsClipboard then FileName := '';
  4818. Message(Application,evBroadcast,cmFileNameChanged,@Self);
  4819. end;
  4820. end;
  4821. function TFileEditor.SaveAsk: boolean;
  4822. var OK: boolean;
  4823. D: Sw_integer;
  4824. begin
  4825. OK:=Modified=false;
  4826. if OK=false then
  4827. begin
  4828. if FileName = '' then D := edSaveUntitled else D := edSaveModify;
  4829. case EditorDialog(D, @FileName) of
  4830. cmYes : OK := Save;
  4831. cmNo : begin Modified := False; OK:=true; end;
  4832. cmCancel : begin
  4833. OK := False;
  4834. Message(Application,evBroadcast,cmSaveCancelled,@Self);
  4835. end;
  4836. end;
  4837. end;
  4838. SaveAsk:=OK;
  4839. end;
  4840. procedure TFileEditor.HandleEvent(var Event: TEvent);
  4841. var SH,B: boolean;
  4842. begin
  4843. case Event.What of
  4844. evBroadcast :
  4845. case Event.Command of
  4846. cmFileNameChanged :
  4847. if (Event.InfoPtr=nil) or (Event.InfoPtr=@Self) then
  4848. begin
  4849. B:=IsFlagSet(efSyntaxHighlight);
  4850. SH:=UseSyntaxHighlight(@Self);
  4851. if SH<>B then
  4852. if SH then
  4853. SetFlags(Flags or efSyntaxHighlight)
  4854. else
  4855. SetFlags(Flags and not efSyntaxHighlight);
  4856. if UseTabsPattern(@Self) then
  4857. SetFlags(Flags or efUseTabCharacters);
  4858. end;
  4859. end;
  4860. end;
  4861. inherited HandleEvent(Event);
  4862. end;
  4863. function TFileEditor.Valid(Command: Word): Boolean;
  4864. var OK: boolean;
  4865. begin
  4866. OK:=inherited Valid(Command);
  4867. if OK and ((Command=cmClose) or (Command=cmQuit)) then
  4868. if IsClipboard=false then
  4869. OK:=SaveAsk;
  4870. Valid:=OK;
  4871. end;
  4872. constructor TFileEditor.Load(var S: TStream);
  4873. var P: PString;
  4874. SSP,SEP,CP,DP: TPoint;
  4875. HR: TRect;
  4876. PA : Array[1..2] of pointer;
  4877. HoldUndo : boolean;
  4878. begin
  4879. inherited Load(S);
  4880. HoldUndo:=StoreUndo;
  4881. StoreUndo:=False;
  4882. P:=S.ReadStr;
  4883. FileName:=GetStr(P);
  4884. if P<>nil then DisposeStr(P);
  4885. UpdateIndicator;
  4886. { Message(@Self,evBroadcast,cmFileNameChanged,@Self);}
  4887. SSP:=SelStart; SEP:=SelEnd;
  4888. CP:=CurPos;
  4889. HR:=Highlight;
  4890. DP:=Delta;
  4891. if FileName<>'' then
  4892. LoadFile;
  4893. if Modified then
  4894. begin
  4895. PA[1]:=@FileName;
  4896. longint(PA[2]):=ChangedLine;
  4897. EditorDialog(edChangedOnloading,@PA);
  4898. end;
  4899. SetHighlight(HR.A,HR.B);
  4900. SetSelection(SSP,SEP);
  4901. SetCurPtr(CP.X,CP.Y);
  4902. ScrollTo(DP.X,DP.Y);
  4903. SetModified(false);
  4904. LimitsChanged;
  4905. StoreUndo:=HoldUndo;
  4906. end;
  4907. procedure TFileEditor.Store(var S: TStream);
  4908. begin
  4909. inherited Store(S);
  4910. S.WriteStr(@FileName);
  4911. end;
  4912. function CreateFindDialog: PDialog;
  4913. var R,R1,R2: TRect;
  4914. D: PDialog;
  4915. IL1: PInputLine;
  4916. Control : PView;
  4917. CB1: PCheckBoxes;
  4918. RB1,RB2,RB3: PRadioButtons;
  4919. begin
  4920. R.Assign(0,0,56,15);
  4921. New(D, Init(R, 'Find'));
  4922. with D^ do
  4923. begin
  4924. Options:=Options or ofCentered;
  4925. GetExtent(R); R.Grow(-3,-2);
  4926. R1.Copy(R); R1.B.X:=17; R1.B.Y:=R1.A.Y+1;
  4927. R2.Copy(R); R2.B.X:=R2.B.X-3;R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
  4928. New(IL1, Init(R2, FindStrSize));
  4929. IL1^.Data^:=FindStr;
  4930. Insert(IL1);
  4931. Insert(New(PLabel, Init(R1, '~T~ext to find', IL1)));
  4932. R1.Assign(R2.B.X, R2.A.Y, R2.B.X+3, R2.B.Y);
  4933. Control := New(PHistory, Init(R1, IL1, TextFindId));
  4934. Insert(Control);
  4935. R1.Copy(R); Inc(R1.A.Y,2); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
  4936. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  4937. New(CB1, Init(R2,
  4938. NewSItem('~C~ase sensitive',
  4939. NewSItem('~W~hole words only',
  4940. nil))));
  4941. Insert(CB1);
  4942. Insert(New(PLabel, Init(R1, 'Options', CB1)));
  4943. R1.Copy(R); Inc(R1.A.Y,2); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
  4944. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  4945. New(RB1, Init(R2,
  4946. NewSItem('Forwar~d~',
  4947. NewSItem('~B~ackward',
  4948. nil))));
  4949. Insert(RB1);
  4950. Insert(New(PLabel, Init(R1, 'Direction', RB1)));
  4951. R1.Copy(R); Inc(R1.A.Y,6); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
  4952. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  4953. New(RB2, Init(R2,
  4954. NewSItem('~G~lobal',
  4955. NewSItem('~S~elected text',
  4956. nil))));
  4957. Insert(RB2);
  4958. Insert(New(PLabel, Init(R1, 'Scope', RB2)));
  4959. R1.Copy(R); Inc(R1.A.Y,6); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
  4960. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  4961. New(RB3, Init(R2,
  4962. NewSItem('~F~rom cursor',
  4963. NewSItem('~E~ntire scope',
  4964. nil))));
  4965. Insert(RB3);
  4966. Insert(New(PLabel, Init(R1, 'Origin', RB3)));
  4967. GetExtent(R); R.Grow(-13,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10;
  4968. Insert(New(PButton, Init(R, 'O~K', cmOK, bfDefault)));
  4969. R.Move(19,0);
  4970. Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  4971. end;
  4972. IL1^.Select;
  4973. CreateFindDialog := D;
  4974. end;
  4975. function CreateReplaceDialog: PDialog;
  4976. var R,R1,R2: TRect;
  4977. D: PDialog;
  4978. Control : PView;
  4979. IL1,IL2: PInputLine;
  4980. CB1: PCheckBoxes;
  4981. RB1,RB2,RB3: PRadioButtons;
  4982. begin
  4983. R.Assign(0,0,56,18);
  4984. New(D, Init(R, 'Replace'));
  4985. with D^ do
  4986. begin
  4987. Options:=Options or ofCentered;
  4988. GetExtent(R); R.Grow(-3,-2);
  4989. R1.Copy(R); R1.B.X:=17; R1.B.Y:=R1.A.Y+1;
  4990. R2.Copy(R); R2.B.X:=R2.B.X-3;R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
  4991. New(IL1, Init(R2, FindStrSize));
  4992. IL1^.Data^:=FindStr;
  4993. Insert(IL1);
  4994. Insert(New(PLabel, Init(R1, '~T~ext to find', IL1)));
  4995. R1.Assign(R2.B.X, R2.A.Y, R2.B.X+3, R2.B.Y);
  4996. Control := New(PHistory, Init(R1, IL1, TextFindId));
  4997. Insert(Control);
  4998. R1.Copy(R); R1.Move(0,2); R1.B.X:=17; R1.B.Y:=R1.A.Y+1;
  4999. R2.Copy(R); R2.Move(0,2);R2.B.X:=R2.B.X-3;
  5000. R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
  5001. New(IL2, Init(R2, FindStrSize));
  5002. IL2^.Data^:=ReplaceStr;
  5003. Insert(IL2);
  5004. Insert(New(PLabel, Init(R1, ' ~N~ew text', IL2)));
  5005. R1.Assign(R2.B.X, R2.A.Y, R2.B.X+3, R2.B.Y);
  5006. Control := New(PHistory, Init(R1, IL2, TextReplaceId));
  5007. Insert(Control);
  5008. R1.Copy(R); Inc(R1.A.Y,4); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
  5009. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+3;
  5010. New(CB1, Init(R2,
  5011. NewSItem('~C~ase sensitive',
  5012. NewSItem('~W~hole words only',
  5013. NewSItem('~P~rompt on replace',
  5014. nil)))));
  5015. Insert(CB1);
  5016. Insert(New(PLabel, Init(R1, 'Options', CB1)));
  5017. R1.Copy(R); Inc(R1.A.Y,4); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
  5018. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  5019. New(RB1, Init(R2,
  5020. NewSItem('Forwar~d~',
  5021. NewSItem('~B~ackward',
  5022. nil))));
  5023. Insert(RB1);
  5024. Insert(New(PLabel, Init(R1, 'Direction', RB1)));
  5025. R1.Copy(R); Inc(R1.A.Y,9); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
  5026. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  5027. New(RB2, Init(R2,
  5028. NewSItem('~G~lobal',
  5029. NewSItem('~S~elected text',
  5030. nil))));
  5031. Insert(RB2);
  5032. Insert(New(PLabel, Init(R1, 'Scope', RB2)));
  5033. R1.Copy(R); Inc(R1.A.Y,9); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
  5034. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  5035. New(RB3, Init(R2,
  5036. NewSItem('~F~rom cursor',
  5037. NewSItem('~E~ntire scope',
  5038. nil))));
  5039. Insert(RB3);
  5040. Insert(New(PLabel, Init(R1, 'Origin', RB3)));
  5041. GetExtent(R); R.Grow(-13,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10; R.Move(-10,0);
  5042. Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
  5043. R.Move(11,0); R.B.X:=R.A.X+14;
  5044. Insert(New(PButton, Init(R, 'Change ~a~ll', cmYes, bfNormal)));
  5045. R.Move(15,0); R.B.X:=R.A.X+10;
  5046. Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  5047. end;
  5048. IL1^.Select;
  5049. CreateReplaceDialog := D;
  5050. end;
  5051. function CreateGotoLineDialog(Info: pointer): PDialog;
  5052. var D: PDialog;
  5053. R,R1,R2: TRect;
  5054. Control : PView;
  5055. IL: PInputLine;
  5056. begin
  5057. R.Assign(0,0,40,7);
  5058. New(D, Init(R, 'Goto line'));
  5059. with D^ do
  5060. begin
  5061. Options:=Options or ofCentered;
  5062. GetExtent(R); R.Grow(-3,-2); R.B.Y:=R.A.Y+1;
  5063. R1.Copy(R); R1.B.X:=27; R2.Copy(R);
  5064. R2.B.X:=R2.B.X-3;R2.A.X:=27;
  5065. New(IL, Init(R2,5));
  5066. with TGotoLineDialogRec(Info^) do
  5067. IL^.SetValidator(New(PRangeValidator, Init(1, Lines)));
  5068. Insert(IL);
  5069. Insert(New(PLabel, Init(R1, 'Enter new line ~n~umber', IL)));
  5070. R1.Assign(R2.B.X, R2.A.Y, R2.B.X+3, R2.B.Y);
  5071. Control := New(PHistory, Init(R1, IL, GotoId));
  5072. Insert(Control);
  5073. GetExtent(R); R.Grow(-8,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10;
  5074. Insert(New(PButton, Init(R, 'O~K', cmOK, bfDefault)));
  5075. R.Move(15,0);
  5076. Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  5077. end;
  5078. IL^.Select;
  5079. CreateGotoLineDialog:=D;
  5080. end;
  5081. function StdEditorDialog(Dialog: Integer; Info: Pointer): Word;
  5082. var
  5083. R: TRect;
  5084. T: TPoint;
  5085. Re: word;
  5086. Name: string;
  5087. DriveNumber : byte;
  5088. StoreDir,StoreDir2 : DirStr;
  5089. Title,DefExt: string;
  5090. AskOW: boolean;
  5091. begin
  5092. case Dialog of
  5093. edOutOfMemory:
  5094. StdEditorDialog := MessageBox('Not enough memory for this operation.',
  5095. nil, mfInsertInApp+ mfError + mfOkButton);
  5096. edReadError:
  5097. StdEditorDialog := MessageBox('Error reading file %s.',
  5098. @Info, mfInsertInApp+ mfError + mfOkButton);
  5099. edWriteError:
  5100. StdEditorDialog := MessageBox('Error writing file %s.',
  5101. @Info, mfInsertInApp+ mfError + mfOkButton);
  5102. edCreateError:
  5103. StdEditorDialog := MessageBox('Error creating file %s.',
  5104. @Info, mfInsertInApp+ mfError + mfOkButton);
  5105. edSaveModify:
  5106. StdEditorDialog := MessageBox('%s has been modified. Save?',
  5107. @Info, mfInsertInApp+ mfInformation + mfYesNoCancel);
  5108. edSaveUntitled:
  5109. StdEditorDialog := MessageBox('Save untitled file?',
  5110. nil, mfInsertInApp+ mfInformation + mfYesNoCancel);
  5111. edChangedOnloading:
  5112. StdEditorDialog := MessageBox(#3'File %s had too long lines'#13#3+
  5113. 'first such line is %d',
  5114. Info, mfInsertInApp+ mfOKButton + mfInformation);
  5115. edFileOnDiskChanged:
  5116. StdEditorDialog := MessageBox(#3'File %s '#13#3+
  5117. 'was modified by another program.'#13#3'Overwrite new version?',
  5118. @info, mfInsertInApp+ mfInformation + mfYesNoCancel);
  5119. edSaveAs,edWriteBlock,edReadBlock:
  5120. begin
  5121. Name:=PString(Info)^;
  5122. GetDir(0,StoreDir);
  5123. DriveNumber:=0;
  5124. if (Length(FileDir)>1) and (FileDir[2]=':') then
  5125. begin
  5126. { does not assume that lowercase are greater then uppercase ! }
  5127. if (FileDir[1]>='a') and (FileDir[1]>='z') then
  5128. DriveNumber:=Ord(FileDir[1])-ord('a')+1
  5129. else
  5130. DriveNumber:=Ord(FileDir[1])-ord('A')+1;
  5131. GetDir(DriveNumber,StoreDir2);
  5132. {$ifndef FPC}
  5133. ChDir(Copy(FileDir,1,2));
  5134. { this sets InOutRes in win32 PM }
  5135. { is this bad? What about an EatIO? Gabor }
  5136. {$endif not FPC}
  5137. end;
  5138. if FileDir<>'' then
  5139. ChDir(FileDir);
  5140. case Dialog of
  5141. edSaveAs :
  5142. begin
  5143. Title:='Save File As';
  5144. DefExt:='*'+DefaultSaveExt;
  5145. end;
  5146. edWriteBlock :
  5147. begin
  5148. Title:='Write Block to File';
  5149. DefExt:='';
  5150. end;
  5151. edReadBlock :
  5152. begin
  5153. Title:='Read Block from File';
  5154. DefExt:='';
  5155. end;
  5156. else begin Title:='???'; DefExt:=''; end;
  5157. end;
  5158. Re:=Application^.ExecuteDialog(New(PFileDialog, Init(DefExt,
  5159. Title, '~N~ame', fdOkButton, FileId)), @Name);
  5160. case Dialog of
  5161. edSaveAs : AskOW:=(Name<>PString(Info)^);
  5162. edWriteBlock : AskOW:=true;
  5163. edReadBlock : AskOW:=false;
  5164. else AskOW:=true;
  5165. end;
  5166. if (Re<>cmCancel) and AskOW then
  5167. begin
  5168. FileDir:=DirOf(FExpand(Name));
  5169. if ExistsFile(Name) then
  5170. if EditorDialog(edReplaceFile,@Name)<>cmYes then
  5171. Re:=cmCancel;
  5172. end;
  5173. if DriveNumber<>0 then
  5174. ChDir(StoreDir2);
  5175. {$ifndef FPC}
  5176. if (Length(StoreDir)>1) and (StoreDir[2]=':') then
  5177. ChDir(Copy(StoreDir,1,2));
  5178. {$endif not FPC}
  5179. if StoreDir<>'' then
  5180. ChDir(StoreDir);
  5181. if Re<>cmCancel then
  5182. PString(Info)^:=Name;
  5183. StdEditorDialog := Re;
  5184. end;
  5185. edGotoLine:
  5186. StdEditorDialog :=
  5187. Application^.ExecuteDialog(CreateGotoLineDialog(Info), Info);
  5188. edFind:
  5189. StdEditorDialog :=
  5190. Application^.ExecuteDialog(CreateFindDialog, Info);
  5191. edSearchFailed:
  5192. StdEditorDialog := MessageBox('Search string not found.',
  5193. nil, mfInsertInApp+ mfError + mfOkButton);
  5194. edReplace:
  5195. StdEditorDialog :=
  5196. Application^.ExecuteDialog(CreateReplaceDialog, Info);
  5197. edReplacePrompt:
  5198. begin
  5199. { Avoid placing the dialog on the same line as the cursor }
  5200. R.Assign(0, 1, 40, 8);
  5201. R.Move((Desktop^.Size.X - R.B.X) div 2, 0);
  5202. Desktop^.MakeGlobal(R.B, T);
  5203. Inc(T.Y);
  5204. if PPoint(Info)^.Y <= T.Y then
  5205. R.Move(0, Desktop^.Size.Y - R.B.Y - 2);
  5206. StdEditorDialog := MessageBoxRect(R, 'Replace this occurence?',
  5207. nil, mfInsertInApp+ mfYesNoCancel + mfInformation);
  5208. end;
  5209. edReplaceFile :
  5210. StdEditorDialog :=
  5211. MessageBox('File %s already exists. Overwrite?',@Info,mfInsertInApp+mfConfirmation+
  5212. mfYesButton+mfNoButton);
  5213. end;
  5214. end;
  5215. function DefUseSyntaxHighlight(Editor: PFileEditor): boolean;
  5216. begin
  5217. DefUseSyntaxHighlight:=Editor^.IsFlagSet(efSyntaxHighlight);
  5218. end;
  5219. function DefUseTabsPattern(Editor: PFileEditor): boolean;
  5220. begin
  5221. DefUseTabsPattern:=Editor^.IsFlagSet(efUseTabCharacters);
  5222. end;
  5223. procedure RegisterCodeEditors;
  5224. begin
  5225. {$ifndef NOOBJREG}
  5226. RegisterType(RIndicator);
  5227. RegisterType(RCodeEditor);
  5228. RegisterType(RFileEditor);
  5229. {$endif}
  5230. end;
  5231. END.
  5232. {
  5233. $Log$
  5234. Revision 1.81 2000-02-09 12:56:54 pierre
  5235. * fix for DelChar past end of line
  5236. Revision 1.80 2000/02/07 12:11:15 pierre
  5237. Gabors changes
  5238. Revision 1.79 2000/02/05 14:50:59 florian
  5239. * applied fix from Gabor regarding the limited line length of the clipboard
  5240. Revision 1.78 2000/01/28 22:20:04 pierre
  5241. * Test_partial_syntax released
  5242. Revision 1.77 2000/01/27 22:30:38 florian
  5243. * start of FPU window
  5244. * current executed line color has a higher priority then a breakpoint now
  5245. Revision 1.76 2000/01/25 00:12:23 pierre
  5246. * fix for Backspace Undo
  5247. Revision 1.75 2000/01/14 15:36:42 pierre
  5248. + GetShortFileName used for tcodeeditor file opening
  5249. Revision 1.74 2000/01/10 23:20:04 pierre
  5250. * problem with Paste solved
  5251. Revision 1.73 2000/01/10 13:25:46 pierre
  5252. + first partial syntax test
  5253. Revision 1.72 2000/01/07 00:19:30 pierre
  5254. * forgot CommentLineType check to see if we need to update format
  5255. on next line
  5256. * some changes for TEST_PARTIAL_SYNTAX still does notwork :(
  5257. Revision 1.71 2000/01/06 17:47:26 pierre
  5258. * avoid to resyntax whole source in unnecessary cases
  5259. Revision 1.70 2000/01/05 17:35:50 pierre
  5260. + Warning box if a line is cut at reading of file
  5261. this is done to avoid loosing completely long lines
  5262. * several TAB related changes
  5263. in particular do not remove or recombine TABs in makefiles
  5264. * fixes for ^KR and ^KW (the was an extra LF at end of
  5265. written block of disk and an error for starting X position
  5266. in SaveAreaToStream)
  5267. Revision 1.69 2000/01/05 00:37:34 pierre
  5268. * ^KC fix
  5269. * better Tab handling
  5270. Revision 1.68 2000/01/04 12:33:08 pierre
  5271. * reinserted version 1.66 lost changes
  5272. + CtrlT Undo works now !
  5273. Revision 1.67 2000/01/03 11:38:35 michael
  5274. Changes from Gabor
  5275. Revision 1.65 1999/12/08 16:02:46 pierre
  5276. * fix for bugs 746,748 and 750
  5277. Revision 1.64 1999/12/01 17:25:00 pierre
  5278. + check if file on disk was changed since load before overwriting
  5279. Revision 1.63 1999/11/22 17:34:08 pierre
  5280. * fix for form bug 634
  5281. Revision 1.62 1999/11/18 13:42:06 pierre
  5282. * Some more Undo stuff
  5283. Revision 1.61 1999/11/10 00:45:30 pierre
  5284. + groupd action started, not yet working
  5285. Revision 1.60 1999/11/05 13:49:13 pierre
  5286. * WinPaste depends on avalaible Clipboard data
  5287. Revision 1.59 1999/11/03 09:39:23 peter
  5288. * fixed uppercase filenames
  5289. * savetostream did twice a -1 on the linecount, so the lastline of a
  5290. file wasn't saved correctly
  5291. Revision 1.58 1999/10/28 15:14:22 pierre
  5292. * get it to compile with debug conditional
  5293. Revision 1.56 1999/10/27 13:32:58 pierre
  5294. * some more Undo Fixes
  5295. Revision 1.55 1999/10/27 10:46:19 pierre
  5296. * More Undo/Redo stuff
  5297. Revision 1.54 1999/10/25 16:49:05 pierre
  5298. + Undo/Redo by Visa Harvey (great thanks) inserted
  5299. (with some modifications)
  5300. Moves work correctly
  5301. Text insertion/deletion are still buggy !
  5302. * LinePosToCharIndex and reverse function changed to get more
  5303. sensible results, dependant code adapted
  5304. * several bug fixes
  5305. Revision 1.53 1999/10/14 10:21:48 pierre
  5306. * more tabs related problems fiwes
  5307. Revision 1.52 1999/10/12 23:35:18 pierre
  5308. + DelStart and SelectWord implemented
  5309. * AddChar(tab) now reacts correctly if efAutoIndent is set
  5310. Revision 1.51 1999/10/08 15:24:50 pierre
  5311. * InsertFrom bug (end of line wasdiscarded)
  5312. Revision 1.50 1999/09/28 23:44:13 pierre
  5313. * text insertion in middle of line was buggy
  5314. Revision 1.49 1999/09/23 16:33:30 pierre
  5315. * ^B^A now prints out the ascii 1 char
  5316. * In SearchReplace Several occurence of a pattern in the same line
  5317. should now be found correctly
  5318. Revision 1.48 1999/09/22 16:16:26 pierre
  5319. + added HistLists for several dialogs
  5320. Revision 1.47 1999/09/21 17:08:59 pierre
  5321. + Windows clipboard for win32
  5322. Revision 1.46 1999/09/13 16:24:44 peter
  5323. + clock
  5324. * backspace unident like tp7
  5325. Revision 1.45 1999/09/09 12:05:33 pierre
  5326. + Copy/Paste to Windows Clipboard
  5327. + efLeaveTrailingSpaces added to editor flags
  5328. (if not set then spaces at the end of a line are
  5329. removed on writing the file)
  5330. Revision 1.44 1999/08/27 15:07:44 pierre
  5331. + cmResetDebuggerRow
  5332. Revision 1.43 1999/08/24 22:04:35 pierre
  5333. + TCodeEditor.SetDebuggerRow
  5334. works like SetHighlightRow but is only disposed by a SetDebuggerRow(-1)
  5335. so the current stop point in debugging is not lost if
  5336. we move the cursor
  5337. Revision 1.42 1999/08/22 22:20:30 pierre
  5338. * selection extension bug removed, via oldEvent pointer in TCodeEditor.HandleEvent
  5339. Revision 1.41 1999/08/16 18:25:28 peter
  5340. * Adjusting the selection when the editor didn't contain any line.
  5341. * Reserved word recognition redesigned, but this didn't affect the overall
  5342. syntax highlight speed remarkably (at least not on my Amd-K6/350).
  5343. The syntax scanner loop is a bit slow but the main problem is the
  5344. recognition of special symbols. Switching off symbol processing boosts
  5345. the performance up to ca. 200%...
  5346. * The editor didn't allow copying (for ex to clipboard) of a single character
  5347. * 'File|Save as' caused permanently run-time error 3. Not any more now...
  5348. * Compiler Messages window (actually the whole desktop) did not act on any
  5349. keypress when compilation failed and thus the window remained visible
  5350. + Message windows are now closed upon pressing Esc
  5351. + At 'Run' the IDE checks whether any sources are modified, and recompiles
  5352. only when neccessary
  5353. + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
  5354. + LineSelect (Ctrl+K+L) implemented
  5355. * The IDE had problems closing help windows before saving the desktop
  5356. Revision 1.40 1999/08/03 20:22:42 peter
  5357. + TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
  5358. + Desktop saving should work now
  5359. - History saved
  5360. - Clipboard content saved
  5361. - Desktop saved
  5362. - Symbol info saved
  5363. * syntax-highlight bug fixed, which compared special keywords case sensitive
  5364. (for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
  5365. * with 'whole words only' set, the editor didn't found occourences of the
  5366. searched text, if the text appeared previously in the same line, but didn't
  5367. satisfied the 'whole-word' condition
  5368. * ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
  5369. (ie. the beginning of the selection)
  5370. * when started typing in a new line, but not at the start (X=0) of it,
  5371. the editor inserted the text one character more to left as it should...
  5372. * TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
  5373. * Shift shouldn't cause so much trouble in TCodeEditor now...
  5374. * Syntax highlight had problems recognizing a special symbol if it was
  5375. prefixed by another symbol character in the source text
  5376. * Auto-save also occours at Dos shell, Tool execution, etc. now...
  5377. Revision 1.39 1999/07/28 23:11:26 peter
  5378. * fixes from gabor
  5379. Revision 1.38 1999/07/12 13:14:24 pierre
  5380. * LineEnd bug corrected, now goes end of text even if selected
  5381. + Until Return for debugger
  5382. + Code for Quit inside GDB Window
  5383. Revision 1.37 1999/06/29 22:50:16 peter
  5384. * more fixes from gabor
  5385. Revision 1.36 1999/06/29 08:51:34 pierre
  5386. * lockflag problems fixed
  5387. Revision 1.35 1999/06/28 19:32:32 peter
  5388. * fixes from gabor
  5389. Revision 1.34 1999/06/28 15:58:07 pierre
  5390. * ShiftDel problem solved
  5391. Revision 1.33 1999/06/25 00:31:51 pierre
  5392. + FileDir remembers the last directory for Open and Save
  5393. Revision 1.32 1999/06/21 23:36:12 pierre
  5394. * Size for Cluster is word (TP compatibility)
  5395. Revision 1.31 1999/05/22 13:44:35 peter
  5396. * fixed couple of bugs
  5397. Revision 1.30 1999/04/15 08:58:10 peter
  5398. * syntax highlight fixes
  5399. * browser updates
  5400. Revision 1.29 1999/04/07 21:55:59 peter
  5401. + object support for browser
  5402. * html help fixes
  5403. * more desktop saving things
  5404. * NODEBUG directive to exclude debugger
  5405. Revision 1.28 1999/03/23 15:11:39 peter
  5406. * desktop saving things
  5407. * vesa mode
  5408. * preferences dialog
  5409. Revision 1.27 1999/03/08 14:58:17 peter
  5410. + prompt with dialogs for tools
  5411. Revision 1.26 1999/03/07 22:58:57 pierre
  5412. * FindRec needs longint for CheckBoxes
  5413. Revision 1.25 1999/03/05 17:39:39 pierre
  5414. * Actions item freeing
  5415. Revision 1.24 1999/03/03 16:45:07 pierre
  5416. * Actions were not dispose in TCodeEditor.Done
  5417. Revision 1.23 1999/03/01 15:42:10 peter
  5418. + Added dummy entries for functions not yet implemented
  5419. * MenuBar didn't update itself automatically on command-set changes
  5420. * Fixed Debugging/Profiling options dialog
  5421. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is set
  5422. * efBackSpaceUnindents works correctly
  5423. + 'Messages' window implemented
  5424. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  5425. + Added TP message-filter support (for ex. you can call GREP thru
  5426. GREP2MSG and view the result in the messages window - just like in TP)
  5427. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  5428. so topic search didn't work...
  5429. * In FPHELP.PAS there were still context-variables defined as word instead
  5430. of THelpCtx
  5431. * StdStatusKeys() was missing from the statusdef for help windows
  5432. + Topic-title for index-table can be specified when adding a HTML-files
  5433. Revision 1.22 1999/02/22 02:15:25 peter
  5434. + default extension for save in the editor
  5435. + Separate Text to Find for the grep dialog
  5436. * fixed redir crash with tp7
  5437. Revision 1.21 1999/02/20 15:18:33 peter
  5438. + ctrl-c capture with confirm dialog
  5439. + ascii table in the tools menu
  5440. + heapviewer
  5441. * empty file fixed
  5442. * fixed callback routines in fpdebug to have far for tp7
  5443. Revision 1.20 1999/02/18 17:27:57 pierre
  5444. * find/replace dialogs need packed records !!
  5445. Revision 1.19 1999/02/18 13:44:36 peter
  5446. * search fixed
  5447. + backward search
  5448. * help fixes
  5449. * browser updates
  5450. Revision 1.18 1999/02/15 15:12:25 pierre
  5451. + TLine remembers Comment type
  5452. Revision 1.17 1999/02/15 09:32:58 pierre
  5453. * single line comment // fix : comments intermix still wrong !!
  5454. Revision 1.16 1999/02/11 19:07:26 pierre
  5455. * GDBWindow redesigned :
  5456. normal editor apart from
  5457. that any kbEnter will send the line (for begin to cursor)
  5458. to GDB command !
  5459. GDBWindow opened in Debugger Menu
  5460. still buggy :
  5461. -echo should not be present if at end of text
  5462. -GDBWindow becomes First after each step (I don't know why !)
  5463. Revision 1.15 1999/02/09 09:29:59 pierre
  5464. * avoid invisible characters in CombineColors
  5465. Revision 1.14 1999/02/05 13:51:45 peter
  5466. * unit name of FPSwitches -> FPSwitch which is easier to use
  5467. * some fixes for tp7 compiling
  5468. Revision 1.13 1999/02/05 13:22:43 pierre
  5469. * bug that caused crash for empty files
  5470. Revision 1.12 1999/02/05 12:04:56 pierre
  5471. + 'loose' centering for debugger
  5472. Revision 1.11 1999/02/04 17:19:26 peter
  5473. * linux fixes
  5474. Revision 1.10 1999/02/04 10:13:00 pierre
  5475. + GetCurrentWord (used in Find/Replace)
  5476. + DefUseTabsPattern (pattern forcing tabs to be kept)
  5477. used for all makefiles !!
  5478. Revision 1.9 1999/01/29 10:34:33 peter
  5479. + needobjdir,needlibdir
  5480. Revision 1.8 1999/01/21 11:54:31 peter
  5481. + tools menu
  5482. + speedsearch in symbolbrowser
  5483. * working run command
  5484. Revision 1.7 1999/01/14 21:41:17 peter
  5485. * use * as modified indicator
  5486. * fixed syntax highlighting
  5487. Revision 1.6 1999/01/12 14:29:44 peter
  5488. + Implemented still missing 'switch' entries in Options menu
  5489. + Pressing Ctrl-B sets ASCII mode in editor, after which keypresses (even
  5490. ones with ASCII < 32 ; entered with Alt+<###>) are interpreted always as
  5491. ASCII chars and inserted directly in the text.
  5492. + Added symbol browser
  5493. * splitted fp.pas to fpide.pas
  5494. Revision 1.5 1999/01/07 15:02:40 peter
  5495. * better tab support
  5496. Revision 1.4 1999/01/04 11:49:55 peter
  5497. * 'Use tab characters' now works correctly
  5498. + Syntax highlight now acts on File|Save As...
  5499. + Added a new class to syntax highlight: 'hex numbers'.
  5500. * There was something very wrong with the palette managment. Now fixed.
  5501. + Added output directory (-FE<xxx>) support to 'Directories' dialog...
  5502. * Fixed some possible bugs in Running/Compiling, and the compilation/run
  5503. process revised
  5504. Revision 1.2 1998/12/28 15:47:55 peter
  5505. + Added user screen support, display & window
  5506. + Implemented Editor,Mouse Options dialog
  5507. + Added location of .INI and .CFG file
  5508. + Option (INI) file managment implemented (see bottom of Options Menu)
  5509. + Switches updated
  5510. + Run program
  5511. Revision 1.4 1998/12/27 12:01:23 gabor
  5512. * efXXXX constants revised for BP compatibility
  5513. * fixed column and row highlighting (needs to rewrite default palette in the INI)
  5514. Revision 1.3 1998/12/22 10:39:54 peter
  5515. + options are now written/read
  5516. + find and replace routines
  5517. }