weditor.pas 236 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892789378947895789678977898789979007901790279037904790579067907790879097910791179127913791479157916791779187919792079217922792379247925792679277928792979307931793279337934793579367937793879397940794179427943794479457946794779487949795079517952795379547955795679577958795979607961796279637964796579667967796879697970797179727973797479757976797779787979798079817982798379847985798679877988798979907991799279937994799579967997799879998000800180028003800480058006800780088009801080118012801380148015801680178018801980208021802280238024802580268027802880298030803180328033803480358036803780388039804080418042804380448045804680478048804980508051805280538054805580568057805880598060806180628063806480658066806780688069807080718072807380748075807680778078807980808081808280838084808580868087808880898090809180928093809480958096809780988099810081018102810381048105810681078108810981108111811281138114811581168117811881198120812181228123812481258126812781288129813081318132813381348135813681378138813981408141814281438144814581468147814881498150815181528153815481558156815781588159816081618162816381648165816681678168816981708171817281738174817581768177817881798180818181828183818481858186818781888189819081918192819381948195819681978198819982008201820282038204820582068207820882098210821182128213821482158216821782188219822082218222822382248225822682278228822982308231823282338234823582368237823882398240824182428243824482458246824782488249825082518252825382548255825682578258825982608261826282638264826582668267826882698270827182728273827482758276827782788279828082818282828382848285828682878288828982908291829282938294829582968297829882998300830183028303830483058306830783088309831083118312831383148315831683178318831983208321832283238324832583268327832883298330833183328333833483358336833783388339834083418342834383448345834683478348834983508351835283538354835583568357835883598360836183628363836483658366836783688369837083718372837383748375837683778378837983808381
  1. {
  2. This file is part of the Free Pascal Integrated Development Environment
  3. Copyright (c) 1998 by Berczi Gabor
  4. Code editor template objects
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {$I globdir.inc}
  12. unit WEditor;
  13. {$ifdef cpullvm}
  14. {$modeswitch nestedprocvars}
  15. {$endif}
  16. interface
  17. {tes}
  18. uses
  19. Dos,Objects,Drivers,Views,Dialogs,Menus,Stddlg,
  20. FVConsts,
  21. WUtils,WViews;
  22. const
  23. cmFileNameChanged = 51234;
  24. cmASCIIChar = 51235;
  25. cmClearLineHighlights = 51236;
  26. cmSaveCancelled = 51237;
  27. cmBreakLine = 51238;
  28. cmSelStart = 51239;
  29. cmSelEnd = 51240;
  30. cmLastCursorPos = 51241;
  31. cmIndentBlock = 51242;
  32. cmUnIndentBlock = 51243;
  33. cmSelectLine = 51244;
  34. cmWriteBlock = 51245;
  35. cmReadBlock = 51246;
  36. cmPrintBlock = 51247;
  37. cmResetDebuggerRow = 51248;
  38. cmAddChar = 51249;
  39. cmExpandCodeTemplate = 51250;
  40. cmUpperCase = 51251;
  41. cmLowerCase = 51252;
  42. cmWindowStart = 51253;
  43. cmWindowEnd = 51254;
  44. cmFindMatchingDelimiter= 51255;
  45. cmFindMatchingDelimiterBack=51256;
  46. cmActivateMenu = 51257;
  47. cmWordLowerCase = 51258;
  48. cmWordUpperCase = 51259;
  49. cmOpenAtCursor = 51260;
  50. cmBrowseAtCursor = 51261;
  51. cmInsertOptions = 51262;
  52. cmToggleCase = 51263;
  53. cmCreateFold = 51264;
  54. cmToggleFold = 51265;
  55. cmCollapseFold = 51266;
  56. cmExpandFold = 51267;
  57. cmDelToEndOfWord = 51268;
  58. cmInputLineLen = 51269;
  59. cmScrollOneUp = 51270;
  60. cmScrollOneDown = 51271;
  61. EditorTextBufSize = 32768;
  62. {$if sizeof(sw_astring)>8}
  63. MaxLineLength = 255; {Shortstring line length}
  64. {$else}
  65. MaxLineLength = 9997; {AnsiString max visible line}
  66. {$endif}
  67. MaxLineCount = 2000000;
  68. CodeTemplateCursorChar = '|'; { AnsiChar to signal cursor pos in templates }
  69. efBackupFiles = $00000001;
  70. efInsertMode = $00000002;
  71. efAutoIndent = $00000004;
  72. efUseTabCharacters = $00000008;
  73. efBackSpaceUnindents = $00000010;
  74. efPersistentBlocks = $00000020;
  75. efSyntaxHighlight = $00000040;
  76. efBlockInsCursor = $00000080;
  77. efVerticalBlocks = $00000100;
  78. efHighlightColumn = $00000200;
  79. efHighlightRow = $00000400;
  80. efAutoBrackets = $00000800;
  81. efExpandAllTabs = $00001000;
  82. efKeepTrailingSpaces = $00002000;
  83. efCodeComplete = $00004000;
  84. efFolds = $00008000;
  85. efNoIndent = $00010000;
  86. efKeepLineAttr = $00020000;
  87. efOverwriteBlocks = $00040000;
  88. efShowIndent = $00080000;
  89. efStoreContent = $80000000;
  90. attrAsm = 1;
  91. attrComment = 2;
  92. attrForceFull = 128;
  93. attrAll = attrAsm+attrComment;
  94. edOutOfMemory = 0;
  95. edReadError = 1;
  96. edWriteError = 2;
  97. edCreateError = 3;
  98. edSaveModify = 4;
  99. edSaveUntitled = 5;
  100. edSaveAs = 6;
  101. edFind = 7;
  102. edSearchFailed = 8;
  103. edReplace = 9;
  104. edReplacePrompt = 10;
  105. edTooManyLines = 11;
  106. edGotoLine = 12;
  107. edReplaceFile = 13;
  108. edWriteBlock = 14;
  109. edReadBlock = 15;
  110. edFileOnDiskChanged = 16;
  111. edChangedOnloading = 17;
  112. edSaveError = 18;
  113. edReloadDiskmodifiedFile = 19;
  114. edReloadDiskAndIDEModifiedFile = 20;
  115. ffmOptions = $0007; ffsOptions = 0;
  116. ffmDirection = $0008; ffsDirection = 3;
  117. ffmScope = $0010; ffsScope = 4;
  118. ffmOrigin = $0020; ffsOrigin = 5;
  119. ffDoReplace = $0040;
  120. ffReplaceAll = $0080;
  121. ffCaseSensitive = $0001;
  122. ffWholeWordsOnly = $0002;
  123. ffPromptOnReplace = $0004;
  124. ffForward = $0000;
  125. ffBackward = $0008;
  126. ffGlobal = $0000;
  127. ffSelectedText = $0010;
  128. ffFromCursor = $0000;
  129. ffEntireScope = $0020;
  130. {$ifdef TEST_REGEXP}
  131. ffUseRegExp = $0100;
  132. ffmUseRegExpFind = $0004;
  133. ffmOptionsFind = $0003;
  134. ffsUseRegExpFind = 8 - 2;
  135. ffmUseRegExpReplace = $0008;
  136. ffsUseRegExpReplace = 8 - 3;
  137. {$endif TEST_REGEXP}
  138. coTextColor = 0;
  139. coWhiteSpaceColor = 1;
  140. coCommentColor = 2;
  141. coReservedWordColor = 3;
  142. coIdentifierColor = 4;
  143. coStringColor = 5;
  144. coNumberColor = 6;
  145. coAssemblerColor = 7;
  146. coSymbolColor = 8;
  147. coDirectiveColor = 9;
  148. coHexNumberColor = 10;
  149. coTabColor = 11;
  150. coAsmReservedColor = 12;
  151. coBreakColor = 13;
  152. coFirstColor = 0;
  153. coLastColor = coBreakColor;
  154. lfBreakpoint = $0001;
  155. lfHighlightRow = $0002;
  156. lfDebuggerRow = $0004;
  157. lfSpecialRow = $0008;
  158. eaMoveCursor = 1;
  159. eaInsertLine = 2;
  160. eaInsertText = 3;
  161. eaDeleteLine = 4;
  162. eaDeleteText = 5;
  163. eaSelectionChanged = 6;
  164. eaCut = 7;
  165. eaPaste = 8;
  166. eaPasteWin = 9;
  167. eaDelChar = 10;
  168. eaClear = 11;
  169. eaCopyBlock = 12;
  170. eaMoveBlock = 13;
  171. eaDelBlock = 14;
  172. eaReadBlock = 15;
  173. eaIndentBlock = 16;
  174. eaUnindentBlock = 17;
  175. eaOverwriteText = 18;
  176. eaUpperCase = 19;
  177. eaLowerCase = 20;
  178. eaToggleCase = 21;
  179. eaCommentSel = 22;
  180. eaUnCommentSel = 23;
  181. eaDummy = 24;
  182. LastAction = eaDummy;
  183. ActionString : array [0..LastAction-1] of string[14] =
  184. ('','Move','InsLine','InsText','DelLine','DelText',
  185. 'SelChange','Cut','Paste','PasteWin','DelChar','Clear',
  186. 'CopyBlock','MoveBlock','DelBlock',
  187. 'ReadBlock','IndentBlock','UnindentBlock','Overwrite',
  188. 'UpperCase','LowerCase','ToggleCase',
  189. 'CommentBlock','UnCommentBlock');
  190. CIndicator = #2#3#1;
  191. CEditor = #33#34#35#36#37#38#39#40#41#42#43#44#45#46#47#48#49#50;
  192. TAB = #9;
  193. FindStrSize = 79;
  194. type
  195. Tcentre = (do_not_centre,do_centre);
  196. PCustomCodeEditor = ^TCustomCodeEditor;
  197. PEditorLineInfo = ^TEditorLineInfo;
  198. PFoldCollection = ^TFoldCollection;
  199. PFold = ^TFold;
  200. TFold = object(TObject)
  201. constructor Init(AEditor: PCustomCodeEditor; AParentFold: PFold; ACollapsed: boolean);
  202. procedure AddReference(P: PObject);
  203. procedure RemoveReference(P: PObject);
  204. procedure AddLineReference(Line: PEditorLineInfo);
  205. procedure RemoveLineReference(Line: PEditorLineInfo);
  206. procedure AddChildReference(Fold: PFold);
  207. procedure RemoveChildReference(Fold: PFold);
  208. function CanDispose: boolean;
  209. function IsCollapsed: boolean;
  210. function IsParent(AFold: PFold): boolean;
  211. function GetLineCount: sw_integer;
  212. procedure Collapse(ACollapse: boolean);
  213. procedure Changed;
  214. function GetLevel: sw_integer;
  215. destructor Done; virtual;
  216. public
  217. ParentFold: PFold;
  218. Collapsed_: boolean;
  219. ReferenceCount: sw_integer;
  220. Editor: PCustomCodeEditor;
  221. LineCount_: sw_integer;
  222. Childs: PFoldCollection;
  223. end;
  224. TFoldCollection = object(TCollection)
  225. function At(Index: sw_Integer): PFold;
  226. end;
  227. PEditorBookMark = ^TEditorBookMark;
  228. TEditorBookMark = packed record {we save bookmarks in *.dsk file, so packed record it is}
  229. Valid : Boolean;
  230. Pos : TPoint;
  231. end;
  232. PEditorBookMarkCollection = ^TEditorBookMarkCollection;
  233. TEditorBookMarkCollection = object(TCollection)
  234. function At(Index: sw_Integer): PEditorBookMark;
  235. end;
  236. TEditorLineInfo = object(TObject)
  237. Editor: PCustomCodeEditor;
  238. {$if sizeof(sw_astring)>8}
  239. Format : PString;
  240. {$else}
  241. Format : Sw_AString;
  242. {$endif}
  243. BeginsWithMultiLineStringSuffixLen,
  244. EndsWithMultiLineStringSuffixLen : Sw_Word;
  245. BeginsWithString,
  246. EndsWithString : boolean;
  247. BeginsWithAsm,
  248. EndsWithAsm : boolean;
  249. BeginsWithComment,
  250. EndsInSingleLineComment,
  251. EndsWithComment : boolean;
  252. BeginsWithDirective,
  253. EndsWithDirective : boolean;
  254. BeginCommentType,EndCommentType : byte;
  255. BeginCommentDepth,EndCommentDepth : sw_integer;
  256. BeginNestedComments,EndNestedComments : byte;
  257. Fold: PFold;
  258. BookMarks: PEditorBookMarkCollection;
  259. constructor Init(AEditor: PCustomCodeEditor);
  260. destructor Done; virtual;
  261. function GetFormat: sw_astring;
  262. procedure SetFormat(const AFormat: sw_astring);
  263. procedure SetFold(AFold: PFold);
  264. procedure InsertMark(Mark:PEditorBookMark); virtual;
  265. procedure DeleteMark(Mark:PEditorBookMark); virtual;
  266. function MarkCount:Sw_integer; virtual;
  267. function GetMark(Index:Sw_integer):PEditorBookMark; virtual;
  268. procedure AdjustMark(APosX,Adjustment:Sw_integer); virtual;
  269. { Syntax information is now generated separately for each editor instance.
  270. This is not neccessary for a one-language IDE, but this unit contains
  271. a _generic_ editor object, which should be (and is) as flexible as
  272. possible.
  273. The overhead caused by generating the same syntax info for ex.
  274. twice isn't so much... - Gabor }
  275. end;
  276. PEditorLineInfoCollection = ^TEditorLineInfoCollection;
  277. TEditorLineInfoCollection = object(TCollection)
  278. function At(Index: sw_Integer): PEditorLineInfo;
  279. end;
  280. PCustomLine = ^TCustomLine;
  281. TCustomLine = object(TObject)
  282. constructor Init(const AText: sw_AString; AFlags: longint);
  283. {a}function GetText: sw_AString; virtual;
  284. {a}procedure SetText(const AText: sw_AString); virtual;
  285. {a}function GetEditorInfo(Editor: PCustomCodeEditor): PEditorLineInfo; virtual;
  286. {a}function GetFlags: longint; virtual;
  287. {a}procedure SetFlags(AFlags: longint); virtual;
  288. function IsFlagSet(AFlag: longint): boolean; {$ifdef USEINLINE}inline;{$endif}
  289. procedure SetFlagState(AFlag: longint; ASet: boolean);
  290. procedure InsertMark(Editor: PCustomCodeEditor; Mark: PEditorBookMark); virtual;
  291. procedure DeleteMark(Editor: PCustomCodeEditor; Mark: PEditorBookMark); virtual;
  292. function MarkCount(Editor: PCustomCodeEditor):Sw_integer; virtual;
  293. function GetMark(Editor: PCustomCodeEditor; Index: Sw_integer):PEditorBookMark; virtual;
  294. procedure AdjustMark(Editor: PCustomCodeEditor; APosX,Adjustment: Sw_integer); virtual;
  295. destructor Done; virtual;
  296. public { internal use only! }
  297. {a}procedure AddEditorInfo(Index: sw_integer; AEditor: PCustomCodeEditor); virtual;
  298. {a}procedure RemoveEditorInfo(AEditor: PCustomCodeEditor); virtual;
  299. end;
  300. PLineCollection = ^TLineCollection;
  301. TLineCollection = object(TCollection)
  302. function At(Index: sw_Integer): PCustomLine;
  303. end;
  304. PEditorAction = ^TEditorAction;
  305. TEditorAction = object(TObject)
  306. StartPos : TPoint;
  307. EndPos : TPoint;
  308. {$if sizeof(sw_astring)>8}
  309. Text : PString;
  310. {$else}
  311. Text : Sw_AString;
  312. {$endif}
  313. ActionCount : longint;
  314. Flags : longint;
  315. Action : byte;
  316. IsGrouped : boolean;
  317. TimeStamp : longint; { this is needed to keep track of line number &
  318. position changes (for ex. for symbol browser)
  319. the line&pos references (eg. symbol info) should
  320. also contain such a timestamp. this will enable
  321. to determine which changes have been made since
  322. storage of the information and thus calculate
  323. the (probably) changed line & position information,
  324. so, we can still jump to the right position in the
  325. editor even when it is heavily modified - Gabor }
  326. constructor init(act:byte; StartP,EndP:TPoint;Txt:Sw_AString;AFlags : longint);
  327. constructor init_group(act:byte);
  328. function is_grouped_action : boolean;
  329. function GetText : sw_astring;
  330. procedure SetText(AText : sw_astring);
  331. destructor done; virtual;
  332. end;
  333. PEditorActionCollection = ^TEditorActionCollection;
  334. TEditorActionCollection = object(TCollection)
  335. CurrentGroupedAction : PEditorAction;
  336. GroupLevel : longint;
  337. function At(Idx : sw_integer) : PEditorAction;
  338. end;
  339. TSpecSymbolClass =
  340. (ssCommentPrefix,ssCommentSingleLinePrefix,ssCommentSuffix,ssStringPrefix,ssStringSuffix,
  341. ssStringMultiLinePrefix,ssStringMultiLineSuffix,
  342. ssDirectivePrefix{,ssDirectiveSuffix},ssAsmPrefix,ssAsmSuffix);
  343. TCompleteState = (csInactive,csOffering,csDenied);
  344. PEditorBinding = ^TEditorBinding;
  345. PEditorBindingCollection = ^TEditorBindingCollection;
  346. TEditorBindingCollection = object(TCollection)
  347. function At(Index: sw_Integer): PEditorBinding;
  348. end;
  349. TEditorBinding = object(TObject)
  350. Editor : PCustomCodeEditor;
  351. constructor Init(AEditor: PCustomCodeEditor);
  352. destructor Done; virtual;
  353. end;
  354. PCustomCodeEditorCore = ^TCustomCodeEditorCore;
  355. TCustomCodeEditorCore = object(TObject)
  356. protected
  357. Bindings : PEditorBindingCollection;
  358. LockFlag : sw_integer;
  359. ChangedLine : sw_integer;
  360. ContentsChangedCalled : boolean;
  361. LimitsChangedCalled : boolean;
  362. ModifiedChangedCalled : boolean;
  363. TabSizeChangedCalled : boolean;
  364. StoreUndoChangedCalled : boolean;
  365. {$ifdef TEST_PARTIAL_SYNTAX}
  366. LastSyntaxedLine : sw_integer;
  367. SyntaxComplete : boolean;
  368. {$endif TEST_PARTIAL_SYNTAX}
  369. public
  370. constructor Init;
  371. procedure BindEditor(AEditor: PCustomCodeEditor);
  372. procedure UnBindEditor(AEditor: PCustomCodeEditor);
  373. function IsEditorBound(AEditor: PCustomCodeEditor): boolean;
  374. function GetBindingCount: sw_integer;
  375. function GetBindingIndex(AEditor: PCustomCodeEditor): sw_integer;
  376. function SearchBinding(AEditor: PCustomCodeEditor): PEditorBinding;
  377. function CanDispose: boolean;
  378. destructor Done; virtual;
  379. public
  380. {a}function GetModified: boolean; virtual;
  381. function GetChangedLine: sw_integer;
  382. {a}procedure SetModified(AModified: boolean); virtual;
  383. {a}function GetStoreUndo: boolean; virtual;
  384. {a}procedure SetStoreUndo(AStore: boolean); virtual;
  385. {a}function GetSyntaxCompleted: boolean; virtual;
  386. {a}procedure SetSyntaxCompleted(SC: boolean); virtual;
  387. {a}function GetTabSize: integer; virtual;
  388. {a}procedure SetTabSize(ATabSize: integer); virtual;
  389. {a}function GetIndentSize: integer; virtual;
  390. {a}procedure SetIndentSize(AIndentSize: integer); virtual;
  391. function IsClipboard: Boolean;
  392. public
  393. { Notifications }
  394. procedure BindingsChanged;
  395. procedure ContentsChanged;
  396. procedure LimitsChanged;
  397. procedure ModifiedChanged;
  398. procedure TabSizeChanged;
  399. procedure StoreUndoChanged;
  400. {a}procedure DoContentsChanged; virtual;
  401. {a}procedure DoLimitsChanged; virtual;
  402. {a}procedure DoModifiedChanged; virtual;
  403. {a}procedure DoTabSizeChanged; virtual;
  404. {a}procedure DoStoreUndoChanged; virtual;
  405. {a}procedure DoSyntaxStateChanged; virtual;
  406. function GetLastVisibleLine : sw_integer;
  407. public
  408. { Storage }
  409. function LoadFromStream(Editor: PCustomCodeEditor; Stream: PFastBufStream): boolean; virtual;
  410. function SaveToStream(Editor: PCustomCodeEditor; Stream: PStream): boolean; virtual;
  411. function SaveAreaToStream(Editor: PCustomCodeEditor; Stream: PStream; StartP,EndP: TPoint): boolean; virtual;
  412. protected
  413. { Text & info storage abstraction }
  414. {a}procedure ISetLineFlagState(Binding: PEditorBinding; LineNo: sw_integer; Flag: longint; ASet: boolean); virtual;
  415. {a}procedure IGetDisplayTextFormat(Binding: PEditorBinding; LineNo: sw_integer;var DT,DF:sw_astring); virtual;
  416. {a}function IGetLineFormat(Binding: PEditorBinding; LineNo: sw_integer): sw_astring; virtual;
  417. {a}procedure ISetLineFormat(Binding: PEditorBinding; LineNo: sw_integer;const S: sw_astring); virtual;
  418. public
  419. { Text & info storage abstraction }
  420. function CharIdxToLinePos(Line,CharIdx: sw_integer): sw_integer;
  421. function LinePosToCharIdx(Line,X: sw_integer): sw_integer;
  422. {a}function GetLineCount: sw_integer; virtual;
  423. {a}function GetLine(LineNo: sw_integer): PCustomLine; virtual;
  424. {a}function GetLineText(LineNo: sw_integer): sw_AString; virtual;
  425. {a}procedure SetDisplayText(I: sw_integer;const S: sw_astring); virtual;
  426. {a}function GetDisplayText(I: sw_integer): sw_astring; virtual;
  427. {a}procedure SetLineText(I: sw_integer;const S: sw_AString); virtual;
  428. procedure GetDisplayTextFormat(Editor: PCustomCodeEditor; I: sw_integer;var DT,DF:sw_astring); virtual;
  429. function GetLineFormat(Editor: PCustomCodeEditor; I: sw_integer): sw_astring; virtual;
  430. procedure SetLineFormat(Editor: PCustomCodeEditor; I: sw_integer;const S: sw_astring); virtual;
  431. {a}procedure DeleteAllLines; virtual;
  432. {a}procedure DeleteLine(I: sw_integer); virtual;
  433. {a}function InsertLine(LineNo: sw_integer; const S: sw_AString): PCustomLine; virtual;
  434. {a}procedure AddLine(const S: sw_AString); virtual;
  435. {a}procedure GetContent(ALines: PUnsortedStringCollection); virtual;
  436. {a}procedure SetContent(ALines: PUnsortedStringCollection); virtual;
  437. public
  438. procedure Lock(AEditor: PCustomCodeEditor);
  439. procedure UnLock(AEditor: PCustomCodeEditor);
  440. function Locked: boolean;
  441. public
  442. { Syntax highlight }
  443. function UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer; virtual;
  444. function UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer; virtual;
  445. function DoUpdateAttrs(Editor: PCustomCodeEditor; FromLine: sw_integer; Attrs: byte): sw_integer; virtual;
  446. function DoUpdateAttrsRange(Editor: PCustomCodeEditor; FromLine, ToLine: sw_integer;
  447. Attrs: byte): sw_integer; virtual;
  448. public
  449. { Undo info storage }
  450. {a}procedure AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: sw_astring;AFlags : longint); virtual;
  451. {a}procedure AddGroupedAction(AAction : byte); virtual;
  452. {a}procedure CloseGroupedAction(AAction : byte); virtual;
  453. {a}function GetUndoActionCount: sw_integer; virtual;
  454. {a}function GetRedoActionCount: sw_integer; virtual;
  455. procedure UpdateUndoRedo(cm : word; action : byte);virtual;
  456. end;
  457. TCaseAction = (caToLowerCase,caToUpperCase,caToggleCase);
  458. TCustomCodeEditor = object(TScroller)
  459. SelStart : TPoint;
  460. SelEnd : TPoint;
  461. Highlight : TRect;
  462. CurPos : TPoint;
  463. ELockFlag : integer;
  464. NoSelect : Boolean;
  465. AlwaysShowScrollBars: boolean;
  466. public
  467. { constructor Load(var S: TStream);
  468. procedure Store(var S: TStream);}
  469. procedure ConvertEvent(var Event: TEvent); virtual;
  470. procedure HandleEvent(var Event: TEvent); virtual;
  471. procedure SetState(AState: Word; Enable: Boolean); virtual;
  472. procedure LocalMenu(P: TPoint); virtual;
  473. function GetLocalMenu: PMenu; virtual;
  474. function GetCommandTarget: PView; virtual;
  475. function CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup; virtual;
  476. function GetPalette: PPalette; virtual;
  477. public
  478. procedure Draw; virtual;
  479. procedure DrawCursor; virtual;
  480. { this is the only way I found to avoid
  481. having the cursor being updated if lock is on PM }
  482. procedure ResetCursor; virtual;
  483. procedure DrawIndicator; virtual;
  484. public
  485. {a}function GetFlags: longint; virtual;
  486. {a}procedure SetFlags(AFlags: longint); virtual;
  487. {a}function GetModified: boolean; virtual;
  488. {a}procedure SetModified(AModified: boolean); virtual;
  489. {a}function GetStoreUndo: boolean; virtual;
  490. {a}procedure SetStoreUndo(AStore: boolean); virtual;
  491. {a}function GetSyntaxCompleted: boolean; virtual;
  492. {a}procedure SetSyntaxCompleted(SC: boolean); virtual;
  493. {a}function GetLastSyntaxedLine: sw_integer; virtual;
  494. {a}procedure SetLastSyntaxedLine(ALine: sw_integer); virtual;
  495. function IsNestedComments(X,Y : sw_integer): boolean; virtual;
  496. function NestedCommentsChangeCheck(CurLine : sw_integer):boolean; virtual;
  497. function IsFlagSet(AFlag: longint): boolean;{$ifdef USEINLINE}inline;{$endif}
  498. function GetReservedColCount: sw_integer; virtual;
  499. {a}function GetTabSize: integer; virtual;
  500. {a}procedure SetTabSize(ATabSize: integer); virtual;
  501. {a}function GetIndentSize: integer; virtual;
  502. {a}procedure SetIndentSize(AIndentSize: integer); virtual;
  503. {a}function IsReadOnly: boolean; virtual;
  504. {a}function IsClipboard: Boolean; virtual;
  505. {a}function GetAutoBrackets: boolean; virtual;
  506. {a}procedure SetAutoBrackets(AutoBrackets: boolean); virtual;
  507. {a}function GetInsertMode: boolean; virtual;
  508. {a}procedure SetInsertMode(InsertMode: boolean); virtual;
  509. procedure SetCurPtr(X,Y: sw_integer); virtual;
  510. function InSelectionArea:boolean; {CurPos in selection area}
  511. procedure GetSelectionArea(var StartP,EndP: TPoint); virtual;
  512. procedure SetSelection(A, B: TPoint); virtual;
  513. procedure SetHighlight(A, B: TPoint); virtual;
  514. procedure ChangeCaseArea(StartP,EndP: TPoint; CaseAction: TCaseAction); virtual;
  515. procedure SetLineFlagState(LineNo: sw_integer; Flags: longint; ASet: boolean);
  516. procedure SetLineFlagExclusive(Flags: longint; LineNo: sw_integer);
  517. procedure Update; virtual;
  518. procedure ScrollTo(X, Y: sw_Integer);
  519. procedure TrackCursor(centre:Tcentre); virtual;
  520. procedure Lock; virtual;
  521. procedure UnLock; virtual;
  522. public
  523. { Text & info storage abstraction }
  524. {a}function GetMaxDisplayLength: sw_integer; virtual; {Max display code points}
  525. {a}function GetLineCount: sw_integer; virtual;
  526. {a}function GetLine(LineNo: sw_integer): PCustomLine; virtual;
  527. {a}function CharIdxToLinePos(Line,CharIdx: sw_integer): sw_integer; virtual;
  528. {a}function LinePosToCharIdx(Line,X: sw_integer): sw_integer; virtual;
  529. {a}function GetLineText(I: sw_integer): sw_astring; virtual;
  530. {a}procedure SetDisplayText(I: sw_integer;const S: sw_astring); virtual;
  531. {a}function GetDisplayText(I: sw_integer): sw_astring; virtual;
  532. {a}procedure SetLineText(I: sw_integer;const S: sw_AString); virtual;
  533. {a}procedure GetDisplayTextFormat(I: sw_integer;var DT,DF:sw_astring); virtual;
  534. {a}function GetLineFormat(I: sw_integer): sw_astring; virtual;
  535. {a}procedure SetLineFormat(I: sw_integer;const S: sw_astring); virtual;
  536. {a}procedure DeleteAllLines; virtual;
  537. {a}procedure DeleteLine(I: sw_integer); virtual;
  538. {a}function InsertLine(LineNo: sw_integer; const S: sw_astring): PCustomLine; virtual;
  539. {a}procedure AddLine(const S: sw_astring); virtual;
  540. {a}function GetErrorMessage: string; virtual;
  541. {a}procedure SetErrorMessage(const S: string); virtual;
  542. {a}procedure AdjustSelection(DeltaX, DeltaY: sw_integer);
  543. {a}procedure AdjustSelectionBefore(DeltaX, DeltaY: sw_integer);
  544. {a}procedure AdjustSelectionPos(OldCurPosX, OldCurPosY: sw_integer; DeltaX, DeltaY: sw_integer);
  545. {a}procedure GetContent(ALines: PUnsortedStringCollection); virtual;
  546. {a}procedure SetContent(ALines: PUnsortedStringCollection); virtual;
  547. {a}function LoadFromStream(Stream: PFastBufStream): boolean; virtual;
  548. {a}function SaveToStream(Stream: PStream): boolean; virtual;
  549. {a}function SaveAreaToStream(Stream: PStream; StartP,EndP: TPoint): boolean;virtual;
  550. function LoadFromFile(const AFileName: string): boolean; virtual;
  551. function SaveToFile(const AFileName: string): boolean; virtual;
  552. function GetBookmark(MarkIdx: sw_integer):TEditorBookMark; virtual;
  553. procedure SetBookmark(MarkIdx: sw_integer; ABookmark: TEditorBookMark); virtual;
  554. function FindMarkLineNr(MarkIdx: sw_integer):sw_integer; virtual;
  555. procedure AdjustBookMark(X, NewX, Y, NewY: sw_integer); virtual;
  556. public
  557. function InsertFrom(Editor: PCustomCodeEditor): Boolean; virtual;
  558. {a}function InsertText(const S: sw_astring): Boolean; virtual;
  559. public
  560. procedure FlagsChanged(OldFlags: longint); virtual;
  561. {a}procedure BindingsChanged; virtual;
  562. procedure ContentsChanged; virtual;
  563. procedure LimitsChanged; virtual;
  564. procedure ModifiedChanged; virtual;
  565. procedure PositionChanged; virtual;
  566. procedure TabSizeChanged; virtual;
  567. procedure SyntaxStateChanged; virtual;
  568. procedure StoreUndoChanged; virtual;
  569. procedure SelectionChanged; virtual;
  570. procedure HighlightChanged; virtual;
  571. {a}procedure DoLimitsChanged; virtual;
  572. public
  573. { Syntax highlight support }
  574. {a}function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
  575. {a}function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring; virtual;
  576. {a}function IsReservedWord(const S: string): boolean; virtual;
  577. {a}function IsAsmReservedWord(const S: string): boolean; virtual;
  578. public
  579. { CodeTemplate support }
  580. {a}function TranslateCodeTemplate(var Shortcut: string; ALines: PUnsortedStringCollection): boolean; virtual;
  581. function SelectCodeTemplate(var ShortCut: string): boolean; virtual;
  582. { CodeComplete support }
  583. {a}function CompleteCodeWord(const WordS: string; var Text: string): boolean; virtual;
  584. {a}function GetCodeCompleteWord: string; virtual;
  585. {a}procedure SetCodeCompleteWord(const S: string); virtual;
  586. {a}function GetCodeCompleteFrag: string; virtual;
  587. {a}procedure SetCodeCompleteFrag(const S: string); virtual;
  588. function GetCompleteState: TCompleteState; virtual;
  589. procedure SetCompleteState(AState: TCompleteState); virtual;
  590. procedure ClearCodeCompleteWord; virtual;
  591. { Fold support }
  592. function GetMaxFoldLevel: sw_integer; virtual;
  593. function GetFoldStringWidth: sw_integer; virtual;
  594. procedure GetFoldStrings(EditorLine: sw_integer; var Prefix, Suffix: openstring); virtual;
  595. {a}function GetFoldCount: sw_integer; virtual;
  596. {a}function GetFold(Index: sw_integer): PFold; virtual;
  597. {a}procedure RegisterFold(AFold: PFold); virtual;
  598. {a}procedure UnRegisterFold(AFold: PFold); virtual;
  599. function ViewToEditorLine(ViewLine: sw_integer): sw_integer;
  600. function EditorToViewLine(EditorLine: sw_integer): sw_integer;
  601. procedure ViewToEditorPoint(P: TPoint; var NP: TPoint);
  602. procedure EditorToViewPoint(P: TPoint; var NP: TPoint);
  603. { Fold support }
  604. function CreateFold(StartY,EndY: sw_integer; Collapsed: boolean): boolean; virtual;
  605. procedure FoldChanged(Fold: PFold); virtual;
  606. procedure RemoveAllFolds; virtual;
  607. public
  608. { Syntax highlight }
  609. {a}function UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer; virtual;
  610. {a}function UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer; virtual;
  611. public
  612. { Undo info storage }
  613. {a}procedure AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: sw_astring;AFlags : longint); virtual;
  614. {a}procedure AddGroupedAction(AAction : byte); virtual;
  615. {a}procedure CloseGroupedAction(AAction : byte); virtual;
  616. {a}function GetUndoActionCount: sw_integer; virtual;
  617. {a}function GetRedoActionCount: sw_integer; virtual;
  618. protected
  619. LastLocalCmd: word;
  620. KeyState : Integer;
  621. Bookmarks : array[0..9] of TEditorBookmark;
  622. DrawCalled,
  623. DrawCursorCalled: boolean;
  624. CurEvent : PEvent;
  625. procedure DrawLines(FirstLine: sw_integer);
  626. function Overwrite: boolean;
  627. function IsModal: boolean;
  628. procedure CheckSels;
  629. procedure CodeCompleteCheck;
  630. procedure CodeCompleteApply;
  631. procedure CodeCompleteCancel;
  632. procedure UpdateUndoRedo(cm : word; action : byte);
  633. procedure HideHighlight;
  634. function ShouldExtend: boolean;
  635. function ValidBlock: boolean;
  636. function GetLineFold(EditorLine: sw_integer): PFold;
  637. function IsLineVisible(EditorLine: sw_integer): boolean; virtual;
  638. function NextVisibleLine(StartLine: sw_integer; Down: boolean): sw_integer;
  639. procedure PushInfo(Const st : string);virtual;
  640. procedure PopInfo;virtual;
  641. public
  642. { Editor primitives }
  643. procedure SelectAll(Enable: boolean); virtual;
  644. procedure CommentSel; virtual;
  645. procedure UnCommentSel; virtual;
  646. public
  647. { Editor commands }
  648. SearchRunCount: integer;
  649. InASCIIMode: boolean;
  650. procedure Indent; virtual;
  651. procedure CharLeft; virtual;
  652. procedure CharRight; virtual;
  653. procedure WordLeft; virtual;
  654. procedure WordRight; virtual;
  655. procedure LineStart; virtual;
  656. procedure LineEnd; virtual;
  657. procedure LineUp; virtual;
  658. procedure LineDown; virtual;
  659. procedure PageUp; virtual;
  660. procedure PageDown; virtual;
  661. procedure ScrollOneUp; virtual;
  662. procedure ScrollOneDown; virtual;
  663. procedure TextStart; virtual;
  664. procedure TextEnd; virtual;
  665. procedure WindowStart; virtual;
  666. procedure WindowEnd; virtual;
  667. procedure JumpSelStart; virtual;
  668. procedure JumpSelEnd; virtual;
  669. procedure JumpMark(MarkIdx: integer); virtual;
  670. procedure DefineMark(MarkIdx: integer); virtual;
  671. procedure JumpToLastCursorPos; virtual;
  672. procedure FindMatchingDelimiter(ScanForward: boolean); virtual;
  673. procedure CreateFoldFromBlock; virtual;
  674. procedure ToggleFold; virtual;
  675. procedure CollapseFold; virtual;
  676. procedure ExpandFold; virtual;
  677. procedure UpperCase; virtual;
  678. procedure LowerCase; virtual;
  679. procedure WordLowerCase; virtual;
  680. procedure WordUpperCase; virtual;
  681. procedure InsertOptions; virtual;
  682. procedure ToggleCase; virtual;
  683. function InsertNewLine: Sw_integer; virtual;
  684. procedure BreakLine; virtual;
  685. procedure BackSpace; virtual;
  686. procedure DelChar; virtual;
  687. procedure DelWord; virtual;
  688. procedure DelToEndOfWord; virtual;
  689. procedure DelStart; virtual;
  690. procedure DelEnd; virtual;
  691. procedure DelLine; virtual;
  692. procedure InsMode; virtual;
  693. procedure StartSelect; virtual;
  694. procedure EndSelect; virtual;
  695. procedure DelSelect; virtual;
  696. procedure HideSelect; virtual;
  697. procedure CopyBlock; virtual;
  698. procedure MoveBlock; virtual;
  699. procedure IndentBlock; virtual;
  700. procedure UnindentBlock; virtual;
  701. procedure SelectWord; virtual;
  702. procedure SelectLine; virtual;
  703. procedure WriteBlock; virtual;
  704. procedure ReadBlock; virtual;
  705. procedure PrintBlock; virtual;
  706. procedure ExpandCodeTemplate; virtual;
  707. procedure AddChar(C: AnsiChar); virtual;
  708. procedure PasteText(P:PAnsiChar; ASize:sw_integer); virtual;
  709. {$ifdef WinClipSupported}
  710. function ClipCopyWin: Boolean; virtual;
  711. function ClipPasteWin: Boolean; virtual;
  712. {$endif WinClipSupported}
  713. function ClipCopy: Boolean; virtual;
  714. procedure ClipCut; virtual;
  715. procedure ClipPaste; virtual;
  716. function GetCurrentWord : string;
  717. function GetCurrentWordArea(var StartP,EndP: TPoint): boolean;
  718. procedure Undo; virtual;
  719. procedure Redo; virtual;
  720. procedure Find; virtual;
  721. procedure Replace; virtual;
  722. procedure DoSearchReplace; virtual;
  723. procedure GotoLine; virtual;
  724. end;
  725. TCodeEditorDialog = function(Dialog: Integer; Info: Pointer): Word;
  726. TEditorInputLine = object(TInputLine)
  727. Procedure HandleEvent(var Event : TEvent);virtual;
  728. end;
  729. PEditorInputLine = ^TEditorInputLine;
  730. TSearchHelperDialog = object(TDialog)
  731. OkButton: PButton;
  732. Procedure HandleEvent(var Event : TEvent);virtual;
  733. end;
  734. PSearchHelperDialog = ^TSearchHelperDialog;
  735. PFPFileInputLine = ^TFPFileInputLine;
  736. TFPFileInputLine = object(TFileInputLine)
  737. constructor Init(var Bounds: TRect; AMaxLen: Sw_Integer);
  738. procedure HandleEvent(var Event: TEvent); virtual;
  739. end;
  740. PFPFileDialog = ^TFPFileDialog;
  741. TFPFileDialog = object(TFileDialog)
  742. constructor Init(AWildCard: TWildStr; const ATitle,
  743. InputName: String; AOptions: Word; HistoryId: Byte);
  744. end;
  745. const
  746. { used for ShiftDel and ShiftIns to avoid
  747. GetShiftState to be considered for extending
  748. selection (PM) }
  749. DontConsiderShiftState: boolean = false;
  750. cut_key:word=kbShiftDel;
  751. copy_key:word=kbCtrlIns;
  752. paste_key:word=kbShiftIns;
  753. all_key:word=kbNoKey;
  754. CodeCompleteMinLen : byte = 4; { minimum length of text to try to complete }
  755. ToClipCmds : TCommandSet = ([cmCut,cmCopy,cmCopyWin,
  756. { cmUnselect should because like cut, copy, copywin:
  757. if there is a selection, it is active, else it isn't }
  758. cmUnselect,cmCommentSel,cmUnCommentSel]);
  759. FromClipCmds : TCommandSet = ([cmPaste]);
  760. NulClipCmds : TCommandSet = ([cmClear]);
  761. UndoCmd : TCommandSet = ([cmUndo]);
  762. RedoCmd : TCommandSet = ([cmRedo]);
  763. function ExtractTabs(S: string; TabSize: Sw_integer): string;
  764. function ExtractTabs(S: AnsiString; TabSize: Sw_integer): AnsiString;
  765. function StdEditorDialog(Dialog: Integer; Info: Pointer): word;
  766. const
  767. DefaultSaveExt : string[12] = '.pas';
  768. FileDir : DirStr = '';
  769. EditorDialog : TCodeEditorDialog = {$ifdef fpc}@{$endif}StdEditorDialog;
  770. Clipboard : PCustomCodeEditor = nil;
  771. FindStr : String[FindStrSize] = '';
  772. ReplaceStr : String[FindStrSize] = '';
  773. FindReplaceEditor : PCustomCodeEditor = nil;
  774. FindFlags : word = ffPromptOnReplace;
  775. {$ifndef NO_UNTYPEDSET}
  776. {$define USE_UNTYPEDSET}
  777. {$endif ndef NO_UNTYPEDSET}
  778. WhiteSpaceChars {$ifdef USE_UNTYPEDSET}: set of AnsiChar {$endif} = [#0,#32,#255];
  779. TabChars {$ifdef USE_UNTYPEDSET}: set of AnsiChar {$endif} = [#9];
  780. HashChars {$ifdef USE_UNTYPEDSET}: set of AnsiChar {$endif} = ['#'];
  781. AlphaChars {$ifdef USE_UNTYPEDSET}: set of AnsiChar {$endif} = ['A'..'Z','a'..'z','_'];
  782. NumberChars {$ifdef USE_UNTYPEDSET}: set of AnsiChar {$endif} = ['0'..'9'];
  783. HexNumberChars {$ifdef USE_UNTYPEDSET}: set of AnsiChar {$endif} = ['0'..'9','A'..'F','a'..'f'];
  784. RealNumberChars {$ifdef USE_UNTYPEDSET}: set of AnsiChar {$endif} = ['E','e','.'{,'+','-'}];
  785. procedure RegisterWEditor;
  786. implementation
  787. uses
  788. Strings,Video,MsgBox,App,Validate,
  789. {$ifdef WinClipSupported}
  790. WinClip,
  791. {$endif WinClipSupported}
  792. {$ifdef TEST_REGEXP}
  793. {$ifdef USE_OLD_REGEXP}
  794. oldregexpr,
  795. {$else not USE_OLD_REGEXP}
  796. regexpr,
  797. {$endif not USE_OLD_REGEXP}
  798. {$endif TEST_REGEXP}
  799. WConsts,WCEdit;
  800. type
  801. RecordWord = sw_word;
  802. TFindDialogRec = packed record
  803. Find : String[FindStrSize];
  804. Options : RecordWord{longint};
  805. { checkboxes need 32 bits PM }
  806. { reverted to word in dialogs.TCluster for TP compatibility (PM) }
  807. { anyhow its complete nonsense : you can only have 16 fields
  808. but use a longint to store it !! }
  809. Direction: RecordWord;{ and tcluster has word size }
  810. Scope : RecordWord;
  811. Origin : RecordWord;
  812. end;
  813. TReplaceDialogRec = packed record
  814. Find : String[FindStrSize];
  815. Replace : String[FindStrSize];
  816. Options : RecordWord{longint};
  817. Direction: RecordWord;
  818. Scope : RecordWord;
  819. Origin : RecordWord;
  820. end;
  821. TGotoLineDialogRec = packed record
  822. LineNo : string[5];
  823. Lines : sw_integer;
  824. end;
  825. const
  826. kbShift = kbLeftShift+kbRightShift;
  827. const
  828. FirstKeyCount = 48;
  829. FirstKeys: array[0..FirstKeyCount * 2] of Word = (FirstKeyCount,
  830. Ord(^A), cmWordLeft, Ord(^B), cmJumpLine, Ord(^C), cmPageDown,
  831. Ord(^D), cmCharRight, Ord(^E), cmLineUp,
  832. Ord(^F), cmWordRight, Ord(^G), cmDelChar,
  833. Ord(^H), cmBackSpace, Ord(^J), cmExpandCodeTemplate,
  834. Ord(^K), $FF02, Ord(^L), cmSearchAgain,
  835. Ord(^M), cmNewLine, Ord(^N), cmBreakLine,
  836. Ord(^O), $FF03,
  837. Ord(^P), cmASCIIChar, Ord(^Q), $FF01,
  838. Ord(^R), cmPageUp, Ord(^S), cmCharLeft,
  839. Ord(^T), cmDelToEndOfWord, Ord(^U), cmUndo,
  840. Ord(^V), cmInsMode, Ord(^X), cmLineDown,
  841. Ord(^Y), cmDelLine, Ord(^W), cmScrollOneUp,
  842. Ord(^Z), cmScrollOneDown, kbLeft, cmCharLeft,
  843. kbRight, cmCharRight, kbCtrlLeft, cmWordLeft,
  844. kbCtrlRight, cmWordRight, kbHome, cmLineStart,
  845. kbCtrlHome, cmWindowStart, kbCtrlEnd, cmWindowEnd,
  846. kbEnd, cmLineEnd, kbUp, cmLineUp,
  847. kbDown, cmLineDown, kbPgUp, cmPageUp,
  848. kbPgDn, cmPageDown, kbCtrlPgUp, cmTextStart,
  849. kbCtrlPgDn, cmTextEnd, kbIns, cmInsMode,
  850. kbDel, cmDelChar, kbShiftIns, cmPaste,
  851. kbShiftDel, cmCut, kbCtrlIns, cmCopy,
  852. kbCtrlDel, cmClear,
  853. kbCtrlGrayMul, cmToggleFold, kbCtrlGrayMinus, cmCollapseFold, kbCtrlGrayPlus, cmExpandFold);
  854. QuickKeyCount = 29;
  855. QuickKeys: array[0..QuickKeyCount * 2] of Word = (QuickKeyCount,
  856. Ord('A'), cmReplace, Ord('C'), cmTextEnd,
  857. Ord('D'), cmLineEnd, Ord('F'), cmFind,
  858. Ord('H'), cmDelStart, Ord('R'), cmTextStart,
  859. Ord('S'), cmLineStart, Ord('Y'), cmDelEnd,
  860. Ord('G'), cmJumpLine, Ord('A'), cmReplace,
  861. Ord('B'), cmSelStart, Ord('K'), cmSelEnd,
  862. Ord('P'), cmLastCursorPos,
  863. Ord('E'), cmWindowStart, Ord('T'), cmWindowStart,
  864. Ord('U'), cmWindowEnd, Ord('X'), cmWindowEnd,
  865. Ord('['), cmFindMatchingDelimiter, Ord(']'), cmFindMatchingDelimiterBack,
  866. Ord('0'), cmJumpMark0, Ord('1'), cmJumpMark1, Ord('2'), cmJumpMark2,
  867. Ord('3'), cmJumpMark3, Ord('4'), cmJumpMark4, Ord('5'), cmJumpMark5,
  868. Ord('6'), cmJumpMark6, Ord('7'), cmJumpMark7, Ord('8'), cmJumpMark8,
  869. Ord('9'), cmJumpMark9);
  870. BlockKeyCount = 30;
  871. BlockKeys: array[0..BlockKeyCount * 2] of Word = (BlockKeyCount,
  872. Ord('B'), cmStartSelect, Ord('C'), cmCopyBlock,
  873. Ord('H'), cmHideSelect, Ord('K'), cmEndSelect,
  874. Ord('Y'), cmDelSelect, Ord('V'), cmMoveBlock,
  875. Ord('I'), cmIndentBlock, Ord('U'), cmUnindentBlock,
  876. Ord('T'), cmSelectWord, Ord('L'), cmSelectLine,
  877. Ord('W'), cmWriteBlock, Ord('R'), cmReadBlock,
  878. Ord('P'), cmPrintBlock,
  879. Ord('N'), cmUpperCase, Ord('O'), cmLowerCase,
  880. Ord('D'), cmActivateMenu,
  881. Ord('E'), cmWordLowerCase, Ord('F'), cmWordUpperCase,
  882. Ord('S'), cmSave, Ord('A'), cmCreateFold,
  883. Ord('0'), cmSetMark0, Ord('1'), cmSetMark1, Ord('2'), cmSetMark2,
  884. Ord('3'), cmSetMark3, Ord('4'), cmSetMark4, Ord('5'), cmSetMark5,
  885. Ord('6'), cmSetMark6, Ord('7'), cmSetMark7, Ord('8'), cmSetMark8,
  886. Ord('9'), cmSetMark9);
  887. MiscKeyCount = 6;
  888. MiscKeys: array[0..MiscKeyCount * 2] of Word = (MiscKeyCount,
  889. Ord('A'), cmOpenAtCursor, Ord('B'), cmBrowseAtCursor,
  890. Ord('G'), cmJumpLine, Ord('O'), cmInsertOptions,
  891. Ord('U'), cmToggleCase, Ord('L'), cmSelectLine);
  892. KeyMap: array[0..3] of Pointer = (@FirstKeys, @QuickKeys, @BlockKeys, @MiscKeys);
  893. function ScanKeyMap(KeyMap: Pointer; KeyCode: Word): Word;
  894. type
  895. pword = ^word;
  896. var
  897. p : pword;
  898. count : sw_word;
  899. begin
  900. p:=keymap;
  901. count:=p^;
  902. inc(p);
  903. while (count>0) do
  904. begin
  905. if (lo(p^)=lo(keycode)) and
  906. ((hi(p^)=0) or (hi(p^)=hi(keycode))) then
  907. begin
  908. inc(p);
  909. scankeymap:=p^;
  910. Exit;
  911. end;
  912. inc(p,2);
  913. dec(count);
  914. end;
  915. scankeymap:=0;
  916. end;
  917. function IsWordSeparator(C: AnsiChar): boolean;
  918. begin
  919. IsWordSeparator:=C in
  920. [' ',#0,#255,':','=','''','"',
  921. '.',',','/',';','$','#',
  922. '(',')','<','>','^','*',
  923. '+','-','?','&','[',']',
  924. '{','}','@','~','%','\',
  925. '!'];
  926. end;
  927. {function IsSpace(C: AnsiChar): boolean;
  928. begin
  929. IsSpace:=C in[' ',#0,#255];
  930. end;}
  931. function LTrim(S: string): string;
  932. begin
  933. while (length(S)>0) and (S[1] in [#0,TAB,#32]) do
  934. Delete(S,1,1);
  935. LTrim:=S;
  936. end;
  937. { TAB are not same as spaces if UseTabs is set PM }
  938. function RTrim(S: string;cut_tabs : boolean): string;
  939. begin
  940. while (length(S)>0) and
  941. ((S[length(S)] in [#0,#32]) or
  942. ((S[Length(S)]=TAB) and cut_tabs)) do
  943. Delete(S,length(S),1);
  944. RTrim:=S;
  945. end;
  946. function Trim(S: string): string;
  947. begin
  948. Trim:=RTrim(LTrim(S),true);
  949. end;
  950. function LTrim(S: AnsiString): AnsiString;
  951. begin
  952. while (length(S)>0) and (S[1] in [#0,TAB,#32]) do
  953. Delete(S,1,1);
  954. LTrim:=S;
  955. end;
  956. { TAB are not same as spaces if UseTabs is set PM }
  957. function RTrim(S: AnsiString;cut_tabs : boolean): AnsiString;
  958. begin
  959. while (length(S)>0) and
  960. ((S[length(S)] in [#0,#32]) or
  961. ((S[Length(S)]=TAB) and cut_tabs)) do
  962. Delete(S,length(S),1);
  963. RTrim:=S;
  964. end;
  965. function Trim(S: AnsiString): AnsiString;
  966. begin
  967. Trim:=RTrim(LTrim(S),true);
  968. end;
  969. function EatIO: integer;
  970. begin
  971. EatIO:=IOResult;
  972. end;
  973. function ExistsFile(const FileName: string): boolean;
  974. var f: file;
  975. Exists: boolean;
  976. begin
  977. if FileName='' then Exists:=false else
  978. begin
  979. {$I-}
  980. Assign(f,FileName);
  981. Reset(f,1);
  982. Exists:=EatIO=0;
  983. Close(f);
  984. EatIO;
  985. {$I+}
  986. end;
  987. ExistsFile:=Exists;
  988. end;
  989. function StrToInt(const S: string): longint;
  990. var L: longint;
  991. C: integer;
  992. begin
  993. Val(S,L,C); if C<>0 then L:=-1;
  994. StrToInt:=L;
  995. end;
  996. type TPosOfs = int64;
  997. function PosToOfs(const X,Y: sw_integer): TPosOfs;
  998. begin
  999. PosToOfs:=TPosOfs(y) shl (sizeof(sw_integer)*8) or x;
  1000. end;
  1001. function PosToOfsP(const P: TPoint): TPosOfs;
  1002. begin
  1003. PosToOfsP:=PosToOfs(P.X,P.Y);
  1004. end;
  1005. function PointOfs(P: TPoint): TPosOfs;
  1006. begin
  1007. PointOfs:={longint(P.Y)*MaxLineLength+P.X}PosToOfsP(P);
  1008. end;
  1009. function ExtractTabs(S: string; TabSize: Sw_integer): string;
  1010. var
  1011. P,PAdd: Sw_integer;
  1012. begin
  1013. p:=0;
  1014. while p<length(s) do
  1015. begin
  1016. inc(p);
  1017. if s[p]=TAB then
  1018. begin
  1019. PAdd:=TabSize-((p-1) mod TabSize);
  1020. s:=copy(S,1,P-1)+CharStr(' ',PAdd)+copy(S,P+1,Length(s));
  1021. inc(P,PAdd-1);
  1022. end;
  1023. end;
  1024. ExtractTabs:=S;
  1025. end;
  1026. function ExtractTabs(S: AnsiString; TabSize: Sw_integer): AnsiString;
  1027. var
  1028. P,PAdd: Sw_integer;
  1029. begin
  1030. p:=0;
  1031. while p<length(s) do
  1032. begin
  1033. inc(p);
  1034. if s[p]=TAB then
  1035. begin
  1036. PAdd:=TabSize-((p-1) mod TabSize);
  1037. s:=copy(S,1,P-1)+CharStr(' ',PAdd)+copy(S,P+1,Length(s));
  1038. inc(P,PAdd-1);
  1039. end;
  1040. end;
  1041. ExtractTabs:=S;
  1042. end;
  1043. {function CompressUsingTabs(S: string; TabSize: byte): string;
  1044. var TabS: string;
  1045. P: byte;
  1046. begin
  1047. TabS:=CharStr(' ',TabSize);
  1048. repeat
  1049. P:=Pos(TabS,S);
  1050. if P>0 then
  1051. S:=copy(S,1,P-1)+TAB+copy(S,P+TabSize,High(S));
  1052. until P=0;
  1053. CompressUsingTabs:=S;
  1054. end;}
  1055. {*****************************************************************************
  1056. Forward/Backward Scanning
  1057. *****************************************************************************}
  1058. Const
  1059. MaxBufLength = $7fffff00;
  1060. NotFoundValue = -1;
  1061. Type
  1062. Btable = Array[0..255] of Byte;
  1063. Procedure BMFMakeTable(const s:string; Var t : Btable);
  1064. Var
  1065. x : sw_integer;
  1066. begin
  1067. FillChar(t,sizeof(t),length(s));
  1068. For x := length(s) downto 1 do
  1069. if (t[ord(s[x])] = length(s)) then
  1070. t[ord(s[x])] := length(s) - x;
  1071. end;
  1072. function BMFScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
  1073. Var
  1074. buffer : Array[0..MaxBufLength-1] of Byte Absolute block;
  1075. s2 : String;
  1076. len,
  1077. numb : Sw_Word;
  1078. found : Boolean;
  1079. begin
  1080. len:=length(str);
  1081. if len>size then
  1082. begin
  1083. BMFScan := NotFoundValue;
  1084. exit;
  1085. end;
  1086. SetLength(s2,len); { sets the length to that of the search String }
  1087. found:=False;
  1088. numb:=pred(len);
  1089. While (not found) and (numb<size) do
  1090. begin
  1091. { partial match }
  1092. if buffer[numb] = ord(str[len]) then
  1093. begin
  1094. { less partial! }
  1095. if buffer[numb-pred(len)] = ord(str[1]) then
  1096. begin
  1097. move(buffer[numb-pred(len)],s2[1],len);
  1098. if (str=s2) then
  1099. begin
  1100. found:=true;
  1101. break;
  1102. end;
  1103. end;
  1104. inc(numb);
  1105. end
  1106. else
  1107. inc(numb,Bt[buffer[numb]]);
  1108. end;
  1109. if not found then
  1110. BMFScan := NotFoundValue
  1111. else
  1112. BMFScan := numb - pred(len);
  1113. end;
  1114. function BMFIScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
  1115. Var
  1116. buffer : Array[0..MaxBufLength-1] of AnsiChar Absolute block;
  1117. len,
  1118. numb,
  1119. x : Sw_Word;
  1120. found : Boolean;
  1121. p : PAnsiChar;
  1122. c : AnsiChar;
  1123. begin
  1124. len:=length(str);
  1125. if (len=0) or (len>size) then
  1126. begin
  1127. BMFIScan := NotFoundValue;
  1128. exit;
  1129. end;
  1130. found:=False;
  1131. numb:=pred(len);
  1132. While (not found) and (numb<size) do
  1133. begin
  1134. { partial match }
  1135. c:=buffer[numb];
  1136. if c in ['a'..'z'] then
  1137. c:=chr(ord(c)-32);
  1138. if (c=str[len]) then
  1139. begin
  1140. { less partial! }
  1141. p:=@buffer[numb-pred(len)];
  1142. x:=1;
  1143. while (x<=len) do
  1144. begin
  1145. if not(((p^ in ['a'..'z']) and (chr(ord(p^)-32)=str[x])) or
  1146. (p^=str[x])) then
  1147. break;
  1148. inc(p);
  1149. inc(x);
  1150. end;
  1151. if (x>len) then
  1152. begin
  1153. found:=true;
  1154. break;
  1155. end;
  1156. inc(numb);
  1157. end
  1158. else
  1159. inc(numb,Bt[ord(c)]);
  1160. end;
  1161. if not found then
  1162. BMFIScan := NotFoundValue
  1163. else
  1164. BMFIScan := numb - pred(len);
  1165. end;
  1166. Procedure BMBMakeTable(const s:string; Var t : Btable);
  1167. Var
  1168. x : sw_integer;
  1169. begin
  1170. FillChar(t,sizeof(t),length(s));
  1171. For x := 1 to length(s)do
  1172. if (t[ord(s[x])] = length(s)) then
  1173. t[ord(s[x])] := x-1;
  1174. end;
  1175. function BMBScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
  1176. Var
  1177. buffer : Array[0..MaxBufLength-1] of Byte Absolute block;
  1178. s2 : String;
  1179. len : Sw_Word;
  1180. numb : Sw_Integer;
  1181. found : Boolean;
  1182. begin
  1183. len:=length(str);
  1184. if len>size then
  1185. begin
  1186. BMBScan := NotFoundValue;
  1187. exit;
  1188. end;
  1189. SetLength(S2,len); { sets the length to that of the search String }
  1190. found:=False;
  1191. numb:=size-len;
  1192. While (not found) and (numb>=0) do
  1193. begin
  1194. { partial match }
  1195. if buffer[numb] = ord(str[1]) then
  1196. begin
  1197. { less partial! }
  1198. if buffer[numb+pred(len)] = ord(str[len]) then
  1199. begin
  1200. move(buffer[numb],s2[1],len);
  1201. if (str=s2) then
  1202. begin
  1203. found:=true;
  1204. break;
  1205. end;
  1206. end;
  1207. dec(numb);
  1208. end
  1209. else
  1210. dec(numb,Bt[buffer[numb]]);
  1211. end;
  1212. if not found then
  1213. BMBScan := NotFoundValue
  1214. else
  1215. BMBScan := numb;
  1216. end;
  1217. function BMBIScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
  1218. Var
  1219. buffer : Array[0..MaxBufLength-1] of AnsiChar Absolute block;
  1220. len,
  1221. x : Sw_Word;
  1222. numb : Sw_Integer;
  1223. found : Boolean;
  1224. p : PAnsiChar;
  1225. c : AnsiChar;
  1226. begin
  1227. len:=length(str);
  1228. if (len=0) or (len>size) then
  1229. begin
  1230. BMBIScan := NotFoundValue;
  1231. exit;
  1232. end;
  1233. found:=False;
  1234. numb:=size-len;
  1235. While (not found) and (numb>=0) do
  1236. begin
  1237. { partial match }
  1238. c:=buffer[numb];
  1239. if c in ['a'..'z'] then
  1240. c:=chr(ord(c)-32);
  1241. if (c=str[1]) then
  1242. begin
  1243. { less partial! }
  1244. p:=@buffer[numb];
  1245. x:=1;
  1246. while (x<=len) do
  1247. begin
  1248. if not(((p^ in ['a'..'z']) and (chr(ord(p^)-32)=str[x])) or
  1249. (p^=str[x])) then
  1250. break;
  1251. inc(p);
  1252. inc(x);
  1253. end;
  1254. if (x>len) then
  1255. begin
  1256. found:=true;
  1257. break;
  1258. end;
  1259. dec(numb);
  1260. end
  1261. else
  1262. dec(numb,Bt[ord(c)]);
  1263. end;
  1264. if not found then
  1265. BMBIScan := NotFoundValue
  1266. else
  1267. BMBIScan := numb;
  1268. end;
  1269. {*****************************************************************************
  1270. PLine,TLineCollection
  1271. *****************************************************************************}
  1272. constructor TCustomLine.Init(const AText: sw_AString; AFlags: longint);
  1273. begin
  1274. inherited Init;
  1275. SetText(AText);
  1276. end;
  1277. function TCustomLine.GetText: sw_AString;
  1278. begin
  1279. Abstract;GetText:='';
  1280. end;
  1281. procedure TCustomLine.SetText(const AText: sw_AString);
  1282. begin
  1283. Abstract;
  1284. end;
  1285. function TCustomLine.GetEditorInfo(Editor: PCustomCodeEditor): PEditorLineInfo;
  1286. begin
  1287. Abstract;
  1288. GetEditorInfo:=nil;
  1289. end;
  1290. function TCustomLine.GetFlags: longint;
  1291. begin
  1292. Abstract;
  1293. GetFlags:=0;
  1294. end;
  1295. procedure TCustomLine.SetFlags(AFlags: longint);
  1296. begin
  1297. Abstract;
  1298. end;
  1299. function TCustomLine.IsFlagSet(AFlag: longint): boolean;{$ifdef USEINLINE}inline;{$endif}
  1300. begin
  1301. IsFlagSet:=(GetFlags and AFlag)=AFlag;
  1302. end;
  1303. procedure TCustomLine.SetFlagState(AFlag: longint; ASet: boolean);
  1304. var N,O: longint;
  1305. begin
  1306. O:=GetFlags; N:=O;
  1307. if ASet then
  1308. N:=N or AFlag
  1309. else
  1310. N:=N and (not AFlag);
  1311. if N<>O then
  1312. SetFlags(N);
  1313. end;
  1314. procedure TCustomLine.InsertMark(Editor: PCustomCodeEditor; Mark: PEditorBookMark);
  1315. var LI : PEditorLineInfo;
  1316. begin
  1317. LI:=GetEditorInfo(@Editor);
  1318. if Assigned(LI) then LI^.InsertMark(Mark);
  1319. end;
  1320. procedure TCustomLine.DeleteMark(Editor: PCustomCodeEditor; Mark: PEditorBookMark);
  1321. var LI : PEditorLineInfo;
  1322. begin
  1323. LI:=GetEditorInfo(@Editor);
  1324. if Assigned(LI) then LI^.DeleteMark(Mark);
  1325. end;
  1326. function TCustomLine.MarkCount(Editor: PCustomCodeEditor):Sw_integer;
  1327. var LI : PEditorLineInfo;
  1328. begin
  1329. LI:=GetEditorInfo(@Editor);
  1330. if Assigned(LI) then MarkCount:=LI^.MarkCount else MarkCount:=0;
  1331. end;
  1332. function TCustomLine.GetMark(Editor: PCustomCodeEditor; Index: Sw_integer):PEditorBookMark;
  1333. var LI : PEditorLineInfo;
  1334. begin
  1335. LI:=GetEditorInfo(@Editor);
  1336. if Assigned(LI) then GetMark:=LI^.GetMark(Index) else GetMark:=nil;
  1337. end;
  1338. procedure TCustomLine.AdjustMark(Editor: PCustomCodeEditor; APosX,Adjustment: Sw_integer);
  1339. var LI : PEditorLineInfo;
  1340. begin
  1341. LI:=GetEditorInfo(@Editor);
  1342. if Assigned(LI) then LI^.AdjustMark(APosX,Adjustment);
  1343. end;
  1344. procedure TCustomLine.AddEditorInfo(Index: sw_integer; AEditor: PCustomCodeEditor);
  1345. begin
  1346. { Abstract }
  1347. end;
  1348. procedure TCustomLine.RemoveEditorInfo(AEditor: PCustomCodeEditor);
  1349. begin
  1350. { Abstract }
  1351. end;
  1352. destructor TCustomLine.Done;
  1353. begin
  1354. inherited Done;
  1355. end;
  1356. function TLineCollection.At(Index: sw_Integer): PCustomLine;
  1357. begin
  1358. At:=inherited At(Index);
  1359. end;
  1360. function TEditorBookMarkCollection.At(Index: sw_Integer): PEditorBookMark;
  1361. begin
  1362. At:=inherited At(Index);
  1363. end;
  1364. constructor TFold.Init(AEditor: PCustomCodeEditor; AParentFold: PFold; ACollapsed: boolean);
  1365. begin
  1366. inherited Init;
  1367. New(Childs, Init(10,10));
  1368. Editor:=AEditor;
  1369. ParentFold:=AParentFold;
  1370. if Assigned(ParentFold) then
  1371. ParentFold^.AddChildReference(@Self);
  1372. Collapsed_:=ACollapsed;
  1373. if Assigned(AEditor) then
  1374. Editor^.RegisterFold(@Self);
  1375. end;
  1376. procedure TFold.AddReference(P: PObject);
  1377. begin
  1378. Inc(ReferenceCount);
  1379. end;
  1380. procedure TFold.RemoveReference(P: PObject);
  1381. begin
  1382. Dec(ReferenceCount);
  1383. if CanDispose then
  1384. Free;
  1385. end;
  1386. procedure TFold.AddLineReference(Line: PEditorLineInfo);
  1387. begin
  1388. Inc(LineCount_);
  1389. AddReference(Line);
  1390. end;
  1391. procedure TFold.RemoveLineReference(Line: PEditorLineInfo);
  1392. begin
  1393. Dec(LineCount_);
  1394. RemoveReference(Line);
  1395. end;
  1396. procedure TFold.AddChildReference(Fold: PFold);
  1397. begin
  1398. Childs^.Insert(Fold);
  1399. AddReference(Fold);
  1400. end;
  1401. procedure TFold.RemoveChildReference(Fold: PFold);
  1402. begin
  1403. Childs^.Delete(Fold);
  1404. RemoveReference(Fold);
  1405. end;
  1406. function TFold.CanDispose: boolean;
  1407. begin
  1408. CanDispose:=ReferenceCount<=0;
  1409. end;
  1410. function TFold.IsCollapsed: boolean;
  1411. var C: boolean;
  1412. begin
  1413. C:=Collapsed_;
  1414. if Assigned(ParentFold) then C:=C or ParentFold^.IsCollapsed;
  1415. IsCollapsed:=C;
  1416. end;
  1417. function TFold.IsParent(AFold: PFold): boolean;
  1418. var P: boolean;
  1419. begin
  1420. P:=(ParentFold=AFold);
  1421. if Assigned(ParentFold) then P:=P or ParentFold^.IsParent(AFold);
  1422. IsParent:=P;
  1423. end;
  1424. function TFold.GetLineCount: sw_integer;
  1425. var Count: sw_integer;
  1426. procedure AddIt(P: PFold);
  1427. begin
  1428. Inc(Count,P^.GetLineCount);
  1429. end;
  1430. begin
  1431. Count:=LineCount_;
  1432. if assigned(Childs) then Childs^.ForEach(TCallbackProcParam(@AddIt));
  1433. GetLineCount:=Count;
  1434. end;
  1435. procedure TFold.Collapse(ACollapse: boolean);
  1436. begin
  1437. if ACollapse<>Collapsed_ then
  1438. begin
  1439. Collapsed_:=ACollapse;
  1440. if (not Collapsed_) and Assigned(ParentFold) then
  1441. ParentFold^.Collapse(false);
  1442. Changed;
  1443. end;
  1444. end;
  1445. procedure TFold.Changed;
  1446. begin
  1447. if Assigned(Editor) then
  1448. Editor^.FoldChanged(@Self);
  1449. end;
  1450. function TFold.GetLevel: sw_integer;
  1451. var Level: sw_integer;
  1452. begin
  1453. Level:=0;
  1454. if Assigned(ParentFold) then
  1455. Inc(Level,1+ParentFold^.GetLevel);
  1456. GetLevel:=Level;
  1457. end;
  1458. destructor TFold.Done;
  1459. begin
  1460. if Assigned(ParentFold) then
  1461. ParentFold^.RemoveChildReference(@Self);
  1462. if Assigned(Editor) then
  1463. Editor^.UnRegisterFold(@Self);
  1464. Childs^.DeleteAll; Dispose(Childs, Done);
  1465. inherited Done;
  1466. end;
  1467. function TFoldCollection.At(Index: sw_Integer): PFold;
  1468. begin
  1469. At:=inherited At(Index);
  1470. end;
  1471. constructor TEditorLineInfo.Init(AEditor: PCustomCodeEditor);
  1472. begin
  1473. inherited Init;
  1474. Editor:=AEditor;
  1475. end;
  1476. function TEditorLineInfo.GetFormat: sw_astring;
  1477. begin
  1478. {$if sizeof(sw_astring)>8}
  1479. GetFormat:=GetStr(Format);
  1480. {$else}
  1481. GetFormat:=Format;
  1482. {$endif}
  1483. end;
  1484. procedure TEditorLineInfo.SetFormat(const AFormat: sw_astring);
  1485. begin
  1486. {$if sizeof(sw_astring)>8}
  1487. SetStr(Format,AFormat);
  1488. {$else}
  1489. Format:=AFormat;
  1490. {$endif}
  1491. end;
  1492. procedure TEditorLineInfo.SetFold(AFold: PFold);
  1493. begin
  1494. if Assigned(Fold) then
  1495. Fold^.RemoveLineReference(@Self);
  1496. Fold:=AFold;
  1497. if Assigned(Fold) then
  1498. Fold^.AddLineReference(@Self);
  1499. end;
  1500. procedure TEditorLineInfo.InsertMark(Mark:PEditorBookMark);
  1501. begin
  1502. if not assigned(BookMarks) then
  1503. New(BookMarks, Init(2,2));
  1504. BookMarks^.Insert(Mark);
  1505. end;
  1506. procedure TEditorLineInfo.DeleteMark(Mark:PEditorBookMark);
  1507. begin
  1508. if assigned(BookMarks) then BookMarks^.Delete(Mark);
  1509. end;
  1510. function TEditorLineInfo.MarkCount:Sw_integer;
  1511. begin
  1512. if assigned(BookMarks) then
  1513. MarkCount:=BookMarks^.Count
  1514. else MarkCount:=0;
  1515. end;
  1516. function TEditorLineInfo.GetMark(Index:Sw_integer):PEditorBookMark;
  1517. begin
  1518. if assigned(BookMarks) then
  1519. GetMark:=BookMarks^.at(Index)
  1520. else GetMark:=nil;
  1521. end;
  1522. procedure TEditorLineInfo.AdjustMark(APosX,Adjustment:Sw_integer);
  1523. var Index : sw_integer;
  1524. Mark:PEditorBookMark;
  1525. begin
  1526. if not assigned(BookMarks) then exit;
  1527. for Index:=1 to BookMarks^.Count do
  1528. begin
  1529. Mark:=BookMarks^.at(Index-1);
  1530. if Mark^.Pos.X >=APosX then
  1531. Mark^.Pos.X:=Mark^.Pos.X+Adjustment
  1532. else
  1533. if (Adjustment < 0) and (Mark^.Pos.X>(APosX+Adjustment)) then
  1534. Mark^.Pos.X:=APosX+Adjustment;
  1535. end;
  1536. end;
  1537. destructor TEditorLineInfo.Done;
  1538. begin
  1539. {$if sizeof(sw_astring)>8}
  1540. if Format<>nil then
  1541. DisposeStr(Format);
  1542. Format:=nil;
  1543. {$else}
  1544. Format:='';
  1545. {$endif}
  1546. SetFold(nil);
  1547. if assigned(BookMarks) then
  1548. begin
  1549. BookMarks^.DeleteAll;
  1550. Dispose(BookMarks,Done);
  1551. BookMarks:=nil;
  1552. end;
  1553. inherited Done;
  1554. end;
  1555. function TEditorLineInfoCollection.At(Index: sw_Integer): PEditorLineInfo;
  1556. begin
  1557. At:=inherited At(Index);
  1558. end;
  1559. function TEditorBindingCollection.At(Index: sw_Integer): PEditorBinding;
  1560. begin
  1561. At:=inherited At(Index);
  1562. end;
  1563. constructor TEditorBinding.Init(AEditor: PCustomCodeEditor);
  1564. begin
  1565. inherited Init;
  1566. Editor:=AEditor;
  1567. end;
  1568. destructor TEditorBinding.Done;
  1569. begin
  1570. inherited Done;
  1571. end;
  1572. constructor TCustomCodeEditorCore.Init;
  1573. begin
  1574. inherited Init;
  1575. New(Bindings, Init(10,10));
  1576. end;
  1577. procedure TCustomCodeEditorCore.BindEditor(AEditor: PCustomCodeEditor);
  1578. var B: PEditorBinding;
  1579. Count,I,Idx: sw_integer;
  1580. L: PCustomLine;
  1581. begin
  1582. assert(Aeditor<>nil);
  1583. New(B, Init(AEditor));
  1584. Bindings^.Insert(B);
  1585. Idx:=Bindings^.IndexOf(B);
  1586. Count:=GetLineCount;
  1587. for I:=0 to Count-1 do
  1588. begin
  1589. L:=GetLine(I);
  1590. if Assigned(L) then
  1591. L^.AddEditorInfo(Idx,AEditor);
  1592. end;
  1593. BindingsChanged;
  1594. end;
  1595. procedure TCustomCodeEditorCore.UnBindEditor(AEditor: PCustomCodeEditor);
  1596. var B: PEditorBinding;
  1597. Count,I: sw_integer;
  1598. L: PCustomLine;
  1599. begin
  1600. assert(Aeditor<>nil);
  1601. B:=SearchBinding(AEditor);
  1602. if Assigned(B) then
  1603. begin
  1604. Count:=GetLineCount;
  1605. for I:=0 to Count-1 do
  1606. begin
  1607. L:=GetLine(I);
  1608. if Assigned(L) then
  1609. L^.RemoveEditorInfo(AEditor);
  1610. end;
  1611. Bindings^.Free(B);
  1612. BindingsChanged;
  1613. end;
  1614. end;
  1615. function TCustomCodeEditorCore.IsEditorBound(AEditor: PCustomCodeEditor): boolean;
  1616. begin
  1617. IsEditorBound:=SearchBinding(AEditor)<>nil;
  1618. end;
  1619. function TCustomCodeEditorCore.GetBindingCount: sw_integer;
  1620. begin
  1621. GetBindingCount:=Bindings^.Count;
  1622. end;
  1623. function TCustomCodeEditorCore.GetBindingIndex(AEditor: PCustomCodeEditor): sw_integer;
  1624. var B: PEditorBinding;
  1625. begin
  1626. B:=SearchBinding(AEditor);
  1627. GetBindingIndex:=Bindings^.IndexOf(B);
  1628. end;
  1629. function TCustomCodeEditorCore.SearchBinding(AEditor: PCustomCodeEditor): PEditorBinding;
  1630. function SearchEditor(P: PEditorBinding): boolean;
  1631. begin
  1632. SearchEditor:=P^.Editor=AEditor;
  1633. end;
  1634. begin
  1635. SearchBinding:=Bindings^.FirstThat(TCallbackFunBoolParam(@SearchEditor));
  1636. end;
  1637. function TCustomCodeEditorCore.CanDispose: boolean;
  1638. begin
  1639. CanDispose:=Assigned(Bindings) and (Bindings^.Count=0);
  1640. end;
  1641. function TCustomCodeEditorCore.GetModified: boolean;
  1642. begin
  1643. Abstract;
  1644. GetModified:=true;
  1645. end;
  1646. function TCustomCodeEditorCore.GetChangedLine: sw_integer;
  1647. begin
  1648. GetChangedLine:=ChangedLine;
  1649. end;
  1650. procedure TCustomCodeEditorCore.SetModified(AModified: boolean);
  1651. begin
  1652. Abstract;
  1653. end;
  1654. function TCustomCodeEditorCore.GetStoreUndo: boolean;
  1655. begin
  1656. Abstract;
  1657. GetStoreUndo:=false;
  1658. end;
  1659. procedure TCustomCodeEditorCore.SetStoreUndo(AStore: boolean);
  1660. begin
  1661. Abstract;
  1662. end;
  1663. function TCustomCodeEditorCore.GetSyntaxCompleted: boolean;
  1664. begin
  1665. Abstract;
  1666. GetSyntaxCompleted:=true;
  1667. end;
  1668. procedure TCustomCodeEditorCore.SetSyntaxCompleted(SC : boolean);
  1669. begin
  1670. Abstract;
  1671. end;
  1672. function TCustomCodeEditorCore.IsClipboard: Boolean;
  1673. function IsClip(P: PEditorBinding): boolean;
  1674. begin
  1675. IsClip:=(P^.Editor=Clipboard);
  1676. end;
  1677. begin
  1678. IsClipBoard:=Bindings^.FirstThat(TCallbackFunBoolParam(@IsClip))<>nil;
  1679. end;
  1680. function TCustomCodeEditorCore.GetTabSize: integer;
  1681. begin
  1682. Abstract;
  1683. GetTabSize:=0;
  1684. end;
  1685. procedure TCustomCodeEditorCore.SetTabSize(ATabSize: integer);
  1686. begin
  1687. Abstract;
  1688. end;
  1689. function TCustomCodeEditorCore.GetIndentSize: integer;
  1690. begin
  1691. Abstract;
  1692. GetIndentSize:=0;
  1693. end;
  1694. procedure TCustomCodeEditorCore.SetIndentSize(AIndentSize: integer);
  1695. begin
  1696. Abstract;
  1697. end;
  1698. procedure TCustomCodeEditorCore.LimitsChanged;
  1699. begin
  1700. if Locked then
  1701. LimitsChangedCalled:=true
  1702. else
  1703. DoLimitsChanged;
  1704. end;
  1705. procedure TCustomCodeEditorCore.ContentsChanged;
  1706. begin
  1707. if Locked then
  1708. ContentsChangedCalled:=true
  1709. else
  1710. DoContentsChanged;
  1711. end;
  1712. procedure TCustomCodeEditorCore.ModifiedChanged;
  1713. begin
  1714. if Locked then
  1715. ModifiedChangedCalled:=true
  1716. else
  1717. DoModifiedChanged;
  1718. end;
  1719. procedure TCustomCodeEditorCore.TabSizeChanged;
  1720. begin
  1721. if Locked then
  1722. TabSizeChangedCalled:=true
  1723. else
  1724. DoTabSizeChanged;
  1725. end;
  1726. procedure TCustomCodeEditorCore.StoreUndoChanged;
  1727. begin
  1728. if Locked then
  1729. StoreUndoChangedCalled:=true
  1730. else
  1731. DoStoreUndoChanged;
  1732. end;
  1733. procedure TCustomCodeEditorCore.BindingsChanged;
  1734. procedure CallIt(P: PEditorBinding);
  1735. begin
  1736. P^.Editor^.BindingsChanged;
  1737. end;
  1738. begin
  1739. Bindings^.ForEach(TCallbackProcParam(@CallIt));
  1740. end;
  1741. procedure TCustomCodeEditorCore.DoLimitsChanged;
  1742. procedure CallIt(P: PEditorBinding);
  1743. begin
  1744. P^.Editor^.DoLimitsChanged;
  1745. end;
  1746. begin
  1747. Bindings^.ForEach(TCallbackProcParam(@CallIt));
  1748. end;
  1749. procedure TCustomCodeEditorCore.DoContentsChanged;
  1750. procedure CallIt(P: PEditorBinding);
  1751. begin
  1752. P^.Editor^.ContentsChanged;
  1753. end;
  1754. begin
  1755. Bindings^.ForEach(TCallbackProcParam(@CallIt));
  1756. end;
  1757. procedure TCustomCodeEditorCore.DoModifiedChanged;
  1758. procedure CallIt(P: PEditorBinding);
  1759. begin
  1760. P^.Editor^.ModifiedChanged;
  1761. end;
  1762. begin
  1763. Bindings^.ForEach(TCallbackProcParam(@CallIt));
  1764. end;
  1765. procedure TCustomCodeEditorCore.DoTabSizeChanged;
  1766. procedure CallIt(P: PEditorBinding);
  1767. begin
  1768. P^.Editor^.TabSizeChanged;
  1769. end;
  1770. begin
  1771. Bindings^.ForEach(TCallbackProcParam(@CallIt));
  1772. end;
  1773. procedure TCustomCodeEditorCore.UpdateUndoRedo(cm : word; action : byte);
  1774. procedure CallIt(P: PEditorBinding);
  1775. begin
  1776. if (P^.Editor^.State and sfActive)<>0 then
  1777. begin
  1778. P^.Editor^.UpdateUndoRedo(cm,action);
  1779. if cm=cmUndo then
  1780. begin
  1781. P^.Editor^.SetCmdState(UndoCmd,true);
  1782. P^.Editor^.SetCmdState(RedoCmd,false);
  1783. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  1784. end;
  1785. end;
  1786. end;
  1787. begin
  1788. Bindings^.ForEach(TCallbackProcParam(@CallIt));
  1789. end;
  1790. procedure TCustomCodeEditorCore.DoStoreUndoChanged;
  1791. procedure CallIt(P: PEditorBinding);
  1792. begin
  1793. P^.Editor^.StoreUndoChanged;
  1794. end;
  1795. begin
  1796. Bindings^.ForEach(TCallbackProcParam(@CallIt));
  1797. end;
  1798. procedure TCustomCodeEditorCore.DoSyntaxStateChanged;
  1799. procedure CallIt(P: PEditorBinding);
  1800. begin
  1801. P^.Editor^.SyntaxStateChanged;
  1802. end;
  1803. begin
  1804. Bindings^.ForEach(TCallbackProcParam(@CallIt));
  1805. end;
  1806. function TCustomCodeEditorCore.GetLastVisibleLine : sw_integer;
  1807. var
  1808. y : sw_integer;
  1809. procedure CallIt(P: PEditorBinding);
  1810. begin
  1811. if y < P^.Editor^.Delta.Y+P^.Editor^.Size.Y then
  1812. y:=P^.Editor^.Delta.Y+P^.Editor^.Size.Y;
  1813. end;
  1814. begin
  1815. y:=0;
  1816. Bindings^.ForEach(TCallbackProcParam(@CallIt));
  1817. GetLastVisibleLine:=y;
  1818. end;
  1819. function TCustomCodeEditorCore.SaveToStream(Editor: PCustomCodeEditor; Stream: PStream): boolean;
  1820. var A,B: TPoint;
  1821. begin
  1822. A.Y:=0; A.X:=0;
  1823. B.Y:=GetLineCount-1;
  1824. if GetLineCount>0 then
  1825. B.X:=length(GetDisplayText(B.Y))
  1826. else
  1827. B.X:=0;
  1828. SaveToStream:=SaveAreaToStream(Editor,Stream,A,B);
  1829. end;
  1830. procedure TCustomCodeEditorCore.ISetLineFlagState(Binding: PEditorBinding; LineNo: sw_integer; Flag: longint; ASet: boolean);
  1831. begin
  1832. Abstract;
  1833. end;
  1834. procedure TCustomCodeEditorCore.IGetDisplayTextFormat(Binding: PEditorBinding; LineNo: sw_integer;var DT,DF:sw_astring);
  1835. begin
  1836. Abstract;
  1837. end;
  1838. function TCustomCodeEditorCore.IGetLineFormat(Binding: PEditorBinding; LineNo: sw_integer): sw_astring;
  1839. begin
  1840. Abstract;
  1841. IGetLineFormat:='';
  1842. end;
  1843. procedure TCustomCodeEditorCore.ISetLineFormat(Binding: PEditorBinding; LineNo: sw_integer;const S: sw_astring);
  1844. begin
  1845. Abstract;
  1846. end;
  1847. function TCustomCodeEditorCore.CharIdxToLinePos(Line,CharIdx: sw_integer): sw_integer;
  1848. var S: sw_astring;
  1849. TabSize,CP,RX,NextInc: sw_integer;
  1850. begin
  1851. S:=GetLineText(Line);
  1852. (* this would fasten the code
  1853. but UseTabCharacters is set for Editor not for EditorCore
  1854. objects,which is dangerous anyway and should be changed ... PM
  1855. if not IsFlagSet(efUseTabCharacters) then
  1856. begin
  1857. if CharIdx<=Length(S) then
  1858. CharIdxToLinePos:=CharIdx-1
  1859. else
  1860. CharIdxToLinePos:=Length(S)-1;
  1861. exit;
  1862. end; *)
  1863. TabSize:=GetTabSize;
  1864. CP:=1; RX:=0;
  1865. NextInc:=0;
  1866. while {(CP<=length(S)) and }(CP<=CharIdx) do
  1867. begin
  1868. if NextInc>0 then
  1869. Inc(RX,NextInc);
  1870. if (CP<=length(S)) and (S[CP]=TAB) then
  1871. NextInc:=TabSize-(RX mod TabSize) -1
  1872. else
  1873. NextInc:=0;
  1874. Inc(RX);
  1875. Inc(CP);
  1876. end;
  1877. CharIdxToLinePos:=RX-1;
  1878. end;
  1879. function TCustomCodeEditorCore.LinePosToCharIdx(Line,X: sw_integer): sw_integer;
  1880. var S: sw_astring;
  1881. TabSize,CP,RX: sw_integer;
  1882. begin
  1883. TabSize:=GetTabSize;
  1884. S:=GetLineText(Line);
  1885. (*
  1886. if not IsFlagSet(efUseTabCharacters) then
  1887. begin
  1888. if S='' then
  1889. CP:=0
  1890. else if (Line<Length(S)) then
  1891. LinePosToCharIdx:=Line+1
  1892. else
  1893. LinePosToCharIdx:=Length(S);
  1894. exit;
  1895. end; *)
  1896. if S='' then
  1897. CP:=X+1
  1898. else
  1899. begin
  1900. CP:=0; RX:=0;
  1901. while (RX<=X) {and (CP<=length(S))} do
  1902. begin
  1903. Inc(CP);
  1904. if (CP<=length(S)) and
  1905. (S[CP]=TAB) then
  1906. Inc(RX,TabSize-(RX mod TabSize))
  1907. else
  1908. Inc(RX);
  1909. end;
  1910. end;
  1911. LinePosToCharIdx:=CP;
  1912. end;
  1913. function TCustomCodeEditorCore.GetLineCount: sw_integer;
  1914. begin
  1915. Abstract;
  1916. GetLineCount:=0;
  1917. end;
  1918. function TCustomCodeEditorCore.GetLine(LineNo: sw_integer): PCustomLine;
  1919. begin
  1920. Abstract;
  1921. GetLine:=nil;
  1922. end;
  1923. function TCustomCodeEditorCore.GetLineText(LineNo: sw_integer): sw_astring;
  1924. begin
  1925. Abstract;
  1926. GetLineText:='';
  1927. end;
  1928. procedure TCustomCodeEditorCore.SetDisplayText(I: sw_integer;const S: sw_astring);
  1929. begin
  1930. Abstract;
  1931. end;
  1932. function TCustomCodeEditorCore.GetDisplayText(I: sw_integer): sw_astring;
  1933. begin
  1934. Abstract;
  1935. GetDisplayText:='';
  1936. end;
  1937. procedure TCustomCodeEditorCore.SetLineText(I: sw_integer;const S: sw_AString);
  1938. begin
  1939. Abstract;
  1940. end;
  1941. procedure TCustomCodeEditorCore.GetDisplayTextFormat(Editor: PCustomCodeEditor; I: sw_integer;var DT,DF:sw_astring);
  1942. begin
  1943. IGetDisplayTextFormat(SearchBinding(Editor),I,DT,DF);
  1944. end;
  1945. function TCustomCodeEditorCore.GetLineFormat(Editor: PCustomCodeEditor; I: sw_integer): sw_astring;
  1946. begin
  1947. GetLineFormat:=IGetLineFormat(SearchBinding(Editor),I);
  1948. end;
  1949. procedure TCustomCodeEditorCore.SetLineFormat(Editor: PCustomCodeEditor; I: sw_integer; const S: sw_astring);
  1950. begin
  1951. ISetLineFormat(SearchBinding(Editor),I,S);
  1952. end;
  1953. procedure TCustomCodeEditorCore.DeleteAllLines;
  1954. begin
  1955. Abstract;
  1956. end;
  1957. procedure TCustomCodeEditorCore.DeleteLine(I: sw_integer);
  1958. begin
  1959. Abstract;
  1960. end;
  1961. function TCustomCodeEditorCore.InsertLine(LineNo: sw_integer; const S: sw_AString): PCustomLine;
  1962. begin
  1963. Abstract;
  1964. InsertLine:=nil; { eliminate compiler warning }
  1965. end;
  1966. procedure TCustomCodeEditorCore.AddLine(const S: sw_AString);
  1967. begin
  1968. Abstract;
  1969. end;
  1970. procedure TCustomCodeEditorCore.GetContent(ALines: PUnsortedStringCollection);
  1971. begin
  1972. Abstract;
  1973. end;
  1974. procedure TCustomCodeEditorCore.SetContent(ALines: PUnsortedStringCollection);
  1975. begin
  1976. Abstract;
  1977. end;
  1978. function TCustomCodeEditorCore.Locked: boolean;
  1979. begin
  1980. Locked:=LockFlag>0;
  1981. end;
  1982. procedure TCustomCodeEditorCore.Lock(AEditor: PCustomCodeEditor);
  1983. begin
  1984. Inc(LockFlag);
  1985. end;
  1986. procedure TCustomCodeEditorCore.UnLock(AEditor: PCustomCodeEditor);
  1987. begin
  1988. {$ifdef DEBUG}
  1989. if LockFlag=0 then
  1990. Bug('negative lockflag',nil)
  1991. else
  1992. {$endif DEBUG}
  1993. Dec(LockFlag);
  1994. if (LockFlag>0) then
  1995. Exit;
  1996. if LimitsChangedCalled then
  1997. begin
  1998. DoLimitsChanged;
  1999. LimitsChangedCalled:=false;
  2000. end;
  2001. if ModifiedChangedCalled then
  2002. begin
  2003. DoModifiedChanged;
  2004. ModifiedChangedCalled:=false;
  2005. end;
  2006. if TabSizeChangedCalled then
  2007. begin
  2008. DoTabSizeChanged;
  2009. TabSizeChangedCalled:=false;
  2010. end;
  2011. if StoreUndoChangedCalled then
  2012. begin
  2013. DoStoreUndoChanged;
  2014. StoreUndoChangedCalled:=false;
  2015. end;
  2016. if ContentsChangedCalled then
  2017. begin
  2018. DoContentsChanged;
  2019. ContentsChangedCalled:=false;
  2020. end;
  2021. end;
  2022. function TCustomCodeEditorCore.UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer;
  2023. var MinLine: sw_integer;
  2024. procedure CallIt(P: PEditorBinding);
  2025. var I: sw_integer;
  2026. AAttrs:byte;
  2027. begin
  2028. AAttrs:=Attrs;
  2029. if P^.Editor^.NestedCommentsChangeCheck(FromLine) then
  2030. AAttrs:=Attrs or attrForceFull;
  2031. I:=DoUpdateAttrs(P^.Editor,FromLine,AAttrs);
  2032. if (I<MinLine) or (MinLine=-1) then MinLine:=I;
  2033. end;
  2034. begin
  2035. MinLine:=-1;
  2036. Bindings^.ForEach(TCallbackProcParam(@CallIt));
  2037. UpdateAttrs:=MinLine;
  2038. end;
  2039. function TCustomCodeEditorCore.UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer;
  2040. var MinLine: sw_integer;
  2041. procedure CallIt(P: PEditorBinding);
  2042. var I: sw_integer;
  2043. AAttrs:byte;
  2044. begin
  2045. AAttrs:=Attrs;
  2046. if P^.Editor^.NestedCommentsChangeCheck(FromLine) then
  2047. AAttrs:=Attrs or attrForceFull;
  2048. I:=DoUpdateAttrsRange(P^.Editor,FromLine,ToLine,AAttrs);
  2049. if (I<MinLine) or (MinLine=-1) then MinLine:=I;
  2050. end;
  2051. begin
  2052. MinLine:=-1;
  2053. Bindings^.ForEach(TCallbackProcParam(@CallIt));
  2054. UpdateAttrsRange:=MinLine;
  2055. end;
  2056. function TCustomCodeEditorCore.DoUpdateAttrs(Editor: PCustomCodeEditor; FromLine: sw_integer; Attrs: byte): sw_integer;
  2057. type
  2058. TCharClass = (ccWhiteSpace,ccTab,ccAlpha,
  2059. ccNumber,ccHexNumber,ccRealNumber,
  2060. ccHash,ccSymbol);
  2061. var
  2062. SymbolIndex: Sw_integer;
  2063. CurLineNr: Sw_integer;
  2064. CurrentCommentType : Byte;
  2065. CurrentCommentDepth : sw_integer;
  2066. NestedComments,LookForNestedComments : boolean;
  2067. CommentStartX,CommentStartY : sw_integer;
  2068. FirstCC,LastCC: TCharClass;
  2069. InAsm,InComment,InSingleLineComment,InDirective,InString,InStringMultiLine: boolean;
  2070. WhiteSpaceLine,OnlyStringSuffix,StringSuffixEnded : boolean;
  2071. X,ClassStart: Sw_integer;
  2072. SymbolConcat: string; {this can be shortstring after all}
  2073. SymbolWord: string; { shortstring }
  2074. MultiLineStringSuffixLen:Sw_Word;
  2075. LineText,Format: sw_astring;
  2076. function MatchSymbol(const What, S: sw_astring): boolean;
  2077. var Match: boolean;
  2078. begin
  2079. Match:=false;
  2080. if length(What)>=length(S) then
  2081. if copy(What,1+length(What)-length(S),length(S))=S then
  2082. Match:=true;
  2083. MatchSymbol:=Match;
  2084. end;
  2085. var MatchedSymbol: boolean;
  2086. MatchingSymbol: sw_astring;
  2087. type TPartialType = (pmNone,pmLeft,pmRight,pmAny);
  2088. function MatchesAnySpecSymbol(SClass: TSpecSymbolClass; PartialMatch: TPartialType): boolean;
  2089. var S: pstring;
  2090. I: Sw_integer;
  2091. Match,Found: boolean;
  2092. begin
  2093. Found:=false;
  2094. if SymbolConcat<>'' then
  2095. for I:=1 to Editor^.GetSpecSymbolCount(SClass) do
  2096. begin
  2097. SymbolIndex:=I;
  2098. S:=Editor^.GetSpecSymbol(SClass,I-1);
  2099. if (length(SymbolConcat)<length(S^)) or
  2100. ((PartialMatch=pmNone) and (length(S^)<>length(SymbolConcat)))
  2101. then
  2102. Match:=false
  2103. else
  2104. begin
  2105. case PartialMatch of
  2106. pmNone : Match:=SymbolConcat=S^;
  2107. pmRight:
  2108. Match:=copy(SymbolConcat,length(SymbolConcat)-length(S^)+1,length(S^))=S^;
  2109. else Match:=MatchSymbol(SymbolConcat,S^);
  2110. end;
  2111. end;
  2112. if Match then
  2113. begin
  2114. MatchingSymbol:=S^; Found:=true; Break;
  2115. end;
  2116. end;
  2117. MatchedSymbol:=MatchedSymbol or Found;
  2118. MatchesAnySpecSymbol:=Found;
  2119. end;
  2120. function MatchesAsmSpecSymbol(Const OrigWhat: string; SClass: TSpecSymbolClass): boolean;
  2121. var What : String;
  2122. S: pstring;
  2123. I: Sw_integer;
  2124. Match,Found: boolean;
  2125. begin
  2126. Found:=false;
  2127. What:=UpcaseStr(OrigWhat);
  2128. if What<>'' then
  2129. for I:=1 to Editor^.GetSpecSymbolCount(SClass) do
  2130. begin
  2131. SymbolIndex:=I;
  2132. S:=Editor^.GetSpecSymbol(SClass,I-1);
  2133. if (length(S^)<>length(What)) then
  2134. Match:=false
  2135. else
  2136. begin
  2137. {if CaseInsensitive then
  2138. S:=UpcaseStr(S); asm symbols need to be uppercased PM }
  2139. {case PartialMatch of
  2140. pmNone : }
  2141. Match:=What=S^;
  2142. { pmRight:
  2143. Match:=copy(What,length(What)-length(S)+1,length(S))=S;
  2144. else Match:=MatchSymbol(What,S);
  2145. end; }
  2146. end;
  2147. if Match then
  2148. begin
  2149. MatchingSymbol:=S^;
  2150. Found:=true;
  2151. Break;
  2152. end;
  2153. end;
  2154. // MatchedSymbol:=MatchedSymbol or Found;
  2155. MatchesAsmSpecSymbol:=Found;
  2156. end;
  2157. function IsCommentPrefix: boolean;
  2158. begin
  2159. IsCommentPrefix:=MatchesAnySpecSymbol(ssCommentPrefix,pmLeft);
  2160. end;
  2161. function IsMatchingCommentPrefix: boolean;
  2162. var tmpIs : boolean;
  2163. begin {looking for nested comments with matching prefix}
  2164. tmpIs:=(MatchesAnySpecSymbol(ssCommentPrefix,pmLeft));
  2165. if tmpIs
  2166. and (CurrentCommentType=2) {bad, we are making assumption that this is comment opener (* }
  2167. and (LineText[X+1]=')') { looking into next char is bad aproach but it is working }
  2168. then
  2169. tmpIs:=false; { in comment this "(*)" is not start of new nested comment but end }
  2170. IsMatchingCommentPrefix:= tmpIs and (CurrentCommentType=SymbolIndex);
  2171. end;
  2172. {** **}
  2173. function IsSingleLineCommentPrefix: boolean;
  2174. begin
  2175. IsSingleLineCommentPrefix:=MatchesAnySpecSymbol(ssCommentSingleLinePrefix,pmLeft);
  2176. end;
  2177. function IsCommentSuffix: boolean;
  2178. var tmpIs : boolean;
  2179. begin
  2180. tmpIs:=(MatchesAnySpecSymbol(ssCommentSuffix,pmRight))
  2181. and (CurrentCommentType=SymbolIndex);
  2182. if tmpIs then
  2183. tmpIs:=(CurLineNr<>CommentStartY) or ((CurLineNr=CommentStartY) and ((X-length(MatchingSymbol))-CommentStartX>=0));
  2184. IsCommentSuffix:=tmpIs;
  2185. end;
  2186. function IsStringPrefix: boolean;
  2187. begin
  2188. IsStringPrefix:=MatchesAnySpecSymbol(ssStringPrefix,pmLeft);
  2189. end;
  2190. function IsStringSuffix: boolean;
  2191. begin
  2192. IsStringSuffix:=MatchesAnySpecSymbol(ssStringSuffix,pmRight);
  2193. end;
  2194. function IsStringMultiLinePrefix: boolean;
  2195. begin
  2196. IsStringMultiLinePrefix:=MatchesAnySpecSymbol(ssStringMultiLinePrefix,pmLeft);
  2197. end;
  2198. function IsStringMultiLineSuffix: boolean;
  2199. begin
  2200. IsStringMultiLineSuffix:=MatchesAnySpecSymbol(ssStringMultiLineSuffix,pmRight);
  2201. end;
  2202. function IsDirectivePrefix: boolean;
  2203. begin
  2204. IsDirectivePrefix:=MatchesAnySpecSymbol(ssDirectivePrefix,pmLeft)
  2205. and (CurrentCommentType=SymbolIndex); {yes - matching comment type}
  2206. end;
  2207. { Directive is treated as comment. Comment suffix will close directive.
  2208. function IsDirectiveSuffix: boolean;
  2209. begin
  2210. IsDirectiveSuffix:=MatchesAnySpecSymbol(ssDirectiveSuffix,pmRight);
  2211. end;}
  2212. function IsAsmPrefix(const WordS: string): boolean;
  2213. { var
  2214. StoredMatchedSymbol : boolean;}
  2215. begin
  2216. {StoredMatchedSymbol:=MatchedSymbol;}
  2217. IsAsmPrefix:=MatchesAsmSpecSymbol(WordS,ssAsmPrefix);
  2218. {MatchedSymbol:=StoredMatchedSymbol;}
  2219. end;
  2220. function IsAsmSuffix(const WordS: string): boolean;
  2221. {var
  2222. StoredMatchedSymbol : boolean;}
  2223. begin
  2224. {StoredMatchedSymbol:=MatchedSymbol;}
  2225. IsAsmSuffix:=MatchesAsmSpecSymbol(WordS,ssAsmSuffix);
  2226. {MatchedSymbol:=StoredMatchedSymbol;}
  2227. end;
  2228. function GetMultiLineStringSuffixLen:Sw_Word;
  2229. var k,i: longword;
  2230. begin
  2231. {get rid of white space at the end of string}
  2232. i:=0;
  2233. for k:=Length(SymbolWord) downto 1 do
  2234. begin
  2235. if not (SymbolWord[k] in [' ',#9,#0,#255]) then
  2236. break;
  2237. inc(i);
  2238. end;
  2239. if i>0 then
  2240. SetLength(SymbolWord,Length(SymbolWord)-i);
  2241. {length of "'" symbols}
  2242. I:=0;
  2243. for k:=Length(SymbolWord) downto 1 do
  2244. begin
  2245. if SymbolWord[k]<>'''' then
  2246. break;
  2247. inc(I);
  2248. end;
  2249. GetMultiLineStringSuffixLen:=I;
  2250. end;
  2251. function GetCharClass(C: AnsiChar): TCharClass;
  2252. var CC: TCharClass;
  2253. begin
  2254. (*
  2255. WhiteSpaceChars {$ifdef USE_UNTYPEDSET}: set of AnsiChar {$endif} = [#0,#32,#255];
  2256. TabChars {$ifdef USE_UNTYPEDSET}: set of AnsiChar {$endif} = [#9];
  2257. HashChars {$ifdef USE_UNTYPEDSET}: set of AnsiChar {$endif} = ['#'];
  2258. AlphaChars {$ifdef USE_UNTYPEDSET}: set of AnsiChar {$endif} = ['A'..'Z','a'..'z','_'];
  2259. NumberChars {$ifdef USE_UNTYPEDSET}: set of AnsiChar {$endif} = ['0'..'9'];
  2260. HexNumberChars {$ifdef USE_UNTYPEDSET}: set of AnsiChar {$endif} = ['0'..'9','A'..'F','a'..'f'];
  2261. RealNumberChars {$ifdef USE_UNTYPEDSET}: set of AnsiChar {$endif} = ['E','e','.'{,'+','-'}];
  2262. *)
  2263. if C in {$ifdef USE_UNTYPEDSET}[#0,#32,#255]{$else}WhiteSpaceChars{$endif} then
  2264. CC:=ccWhiteSpace
  2265. else if C in {$ifdef USE_UNTYPEDSET}[#9]{$else}TabChars{$endif} then
  2266. CC:=ccTab
  2267. else if C in {$ifdef USE_UNTYPEDSET}['#']{$else}HashChars{$endif} then
  2268. CC:=ccHash
  2269. else if (LastCC=ccHexNumber) and (C in {$ifdef USE_UNTYPEDSET}['0'..'9','A'..'F','a'..'f']{$else}HexNumberChars{$endif}) then
  2270. CC:=ccHexNumber
  2271. else if C in {$ifdef USE_UNTYPEDSET}['0'..'9']{$else}NumberChars{$endif} then
  2272. CC:=ccNumber
  2273. else if (LastCC=ccNumber) and (C in {$ifdef USE_UNTYPEDSET}['E','e','.']{$else}RealNumberChars{$endif}) then
  2274. begin
  2275. if (C='.') then
  2276. begin
  2277. if (X>=length(LineText)) or
  2278. (LineText[X+1]='.') then
  2279. cc:=ccSymbol
  2280. else
  2281. cc:=ccRealNumber;
  2282. end
  2283. else {'E','e'}
  2284. begin
  2285. if (X>=length(LineText)) or
  2286. (LineText[X+1]in ['+','-','0'..'9']) then
  2287. cc:=ccRealNumber
  2288. else
  2289. cc:=ccAlpha
  2290. end;
  2291. end
  2292. else if C in {$ifdef USE_UNTYPEDSET}['A'..'Z','a'..'z','_']{$else}AlphaChars{$endif} then CC:=ccAlpha else
  2293. CC:=ccSymbol;
  2294. GetCharClass:=CC;
  2295. end;
  2296. procedure FormatWord(SClass: TCharClass; StartX:Sw_integer;EndX: Sw_integer);
  2297. var
  2298. C: byte;
  2299. WordS: string; {Note: leave for now as ShortString}
  2300. begin
  2301. C:=0;
  2302. WordS:=copy(LineText,StartX,EndX-StartX+1);
  2303. if (InAsm=true) and (InComment=false) and (InString=false) and
  2304. (InDirective=false) and (SClass=ccAlpha) and IsAsmSuffix(WordS) then InAsm:=false;
  2305. if InDirective then C:=coDirectiveColor else
  2306. if InComment then C:=coCommentColor else
  2307. if InString then C:=coStringColor else
  2308. if InAsm then
  2309. begin
  2310. if (SClass=ccAlpha) and Editor^.IsAsmReservedWord(WordS) then
  2311. C:=coReservedWordColor
  2312. else
  2313. C:=coAssemblerColor;
  2314. end
  2315. else
  2316. case SClass of
  2317. ccWhiteSpace :
  2318. C:=coWhiteSpaceColor;
  2319. ccTab :
  2320. C:=coTabColor;
  2321. ccHexNumber:
  2322. C:=coHexNumberColor;
  2323. ccNumber,
  2324. ccRealNumber :
  2325. C:=coNumberColor;
  2326. ccHash :
  2327. C:=coStringColor;
  2328. ccSymbol :
  2329. C:=coSymbolColor;
  2330. ccAlpha :
  2331. begin
  2332. if Editor^.IsReservedWord(WordS) then
  2333. C:=coReservedWordColor
  2334. else
  2335. C:=coIdentifierColor;
  2336. end;
  2337. end;
  2338. if EndX+1>=StartX then
  2339. FillChar(Format[StartX],EndX+1-StartX,C);
  2340. if (InString=false) and (InAsm=false) and (InComment=false) and
  2341. (InDirective=false) and (SClass=ccAlpha) and IsAsmPrefix(WordS) then
  2342. InAsm:=true;
  2343. end;
  2344. procedure ProcessChar(C: AnsiChar);
  2345. var CC: TCharClass;
  2346. EX: Sw_integer;
  2347. EndComment: pstring;
  2348. begin
  2349. CC:=GetCharClass(C);
  2350. if ClassStart=X then
  2351. FirstCC:=CC;
  2352. if ( (CC<>LastCC) and
  2353. (
  2354. ((FirstCC=ccNumber) and (CC<>ccRealNumber) {and (CC<>ccNumber)}) or
  2355. (((CC<>ccAlpha) or (LastCC<>ccNumber) ) and
  2356. ( (CC<>ccNumber) or (LastCC<>ccAlpha) ) and
  2357. ( (CC<>ccNumber) or (LastCC<>ccHash) ) and
  2358. ( (CC<>ccRealNumber) or (LastCC<>ccNumber))
  2359. ))) or
  2360. (X>length(LineText)) or (CC=ccSymbol) then
  2361. begin
  2362. MatchedSymbol:=false;
  2363. EX:=X-1;
  2364. if length(SymbolWord)>=High(SymbolWord) then
  2365. Delete(SymbolWord,1,1);
  2366. SymbolWord:=SymbolWord+C; { for variable length multi line string end detection }
  2367. if OnlyStringSuffix then
  2368. begin
  2369. OnlyStringSuffix:=(C='''');
  2370. if not OnlyStringSuffix then
  2371. begin
  2372. SetLength(SymbolWord,Length(SymbolWord)-1);
  2373. if (GetMultiLineStringSuffixLen>=MultiLineStringSuffixLen) then
  2374. StringSuffixEnded:=true;
  2375. end;
  2376. end;
  2377. if (CC=ccSymbol) then
  2378. begin
  2379. if length(SymbolConcat)>=High(SymbolConcat) then
  2380. Delete(SymbolConcat,1,1);
  2381. SymbolConcat:=SymbolConcat+C;
  2382. if InComment and IsCommentSuffix then
  2383. Inc(EX) else
  2384. if InString and IsStringSuffix then
  2385. Inc(EX) else
  2386. if InString and (InStringMultiLine=true) and IsStringMultiLineSuffix then
  2387. Inc(EX) {else
  2388. if InDirective and IsDirectiveSuffix then
  2389. Inc(EX)};
  2390. end;
  2391. if StringSuffixEnded then
  2392. begin
  2393. MultiLineStringSuffixLen:=0;
  2394. StringSuffixEnded:=false;
  2395. if (GetMultiLineStringSuffixLen and 1)= 1 then
  2396. InString:=false;
  2397. InStringMultiLine:=false;
  2398. end;
  2399. if (CC<>ccSymbol) then
  2400. begin
  2401. if (CC<>ccWhiteSpace) and (CC<>ccTab) then
  2402. SymbolWord:='';
  2403. OnlyStringSuffix:=false;
  2404. end;
  2405. if CC=ccRealNumber then
  2406. Inc(EX);
  2407. if (C='$') and (MatchedSymbol=false) and (IsDirectivePrefix=false) then
  2408. CC:=ccHexNumber;
  2409. if CC<>ccSymbol then SymbolConcat:='';
  2410. FormatWord(LastCC,ClassStart,EX);
  2411. ClassStart:=EX+1;
  2412. if ClassStart=X then
  2413. FirstCC:=CC;
  2414. case CC of
  2415. ccAlpha : ;
  2416. ccNumber :
  2417. if (LastCC<>ccAlpha) then;
  2418. ccSymbol :
  2419. if (InComment=true) and (CurrentCommentDepth=1) and
  2420. (InDirective=false) and IsDirectivePrefix then
  2421. begin
  2422. InDirective:=true;
  2423. {InComment:=false;} { treat compiler directive as comment }
  2424. {CurrentCommentType:=0;}
  2425. Dec(ClassStart,length(MatchingSymbol)-1);
  2426. end
  2427. else {if (InComment=false) and
  2428. (InDirective=true) and IsDirectiveSuffix then
  2429. InDirective:=false
  2430. else }if (InComment=false) and
  2431. (InString=false) and (InDirective=false) and IsCommentPrefix then
  2432. begin
  2433. InComment:=true;
  2434. LookForNestedComments:=true;
  2435. CurrentCommentType:=SymbolIndex;
  2436. CurrentCommentDepth:=1;
  2437. InSingleLineComment:=IsSingleLineCommentPrefix;
  2438. CommentStartX:=X;
  2439. CommentStartY:=CurLineNr;
  2440. {InString:=false; }
  2441. Dec(ClassStart,length(MatchingSymbol)-1);
  2442. { Remove (* from SymbolConcat to avoid problem with (*) PM }
  2443. { fixes part of bug 1617 }
  2444. { but removed proper directive prefix detection ... }
  2445. { Well. Added false positive end suffix detection. Do not remove. M
  2446. EndComment:=Editor^.GetSpecSymbol(ssCommentSuffix,SymbolIndex);
  2447. if MatchingSymbol[length(MatchingSymbol)]=EndComment^[1] then
  2448. Delete(SymbolConcat,1,length(MatchingSymbol));}
  2449. end
  2450. else if InComment and IsMatchingCommentPrefix then
  2451. begin
  2452. inc(CurrentCommentDepth);
  2453. if LookForNestedComments then
  2454. begin { once per every nested comment test IsNestedCommments }
  2455. LookForNestedComments:=false;
  2456. NestedComments:=Editor^.IsNestedComments(X,CurLineNr);
  2457. end;
  2458. end
  2459. else if InComment and IsCommentSuffix then
  2460. begin
  2461. dec(CurrentCommentDepth);
  2462. if not NestedComments then
  2463. CurrentCommentDepth:=0;
  2464. if CurrentCommentDepth=0 then
  2465. begin
  2466. InComment:=false;
  2467. CurrentCommentType:=0;
  2468. InDirective:=false; {not in comment then not in Directive}
  2469. InString:=false;
  2470. InStringMultiLine:=false;
  2471. end;
  2472. end
  2473. else if (InComment=false) and (InString=false) and IsStringPrefix then
  2474. begin
  2475. InString:=true;
  2476. Dec(ClassStart,length(MatchingSymbol)-1);
  2477. end
  2478. else if (InComment=false) and (InString=false) and IsStringMultiLinePrefix then
  2479. begin
  2480. InString:=true;
  2481. InStringMultiLine:=true;
  2482. Dec(ClassStart,length(MatchingSymbol)-1);
  2483. end
  2484. else if (InComment=false) and (InString=true) and (InStringMultiLine=false) and IsStringSuffix then
  2485. begin
  2486. InString:=false;
  2487. end
  2488. else if (InComment=false) and (InString=true) and (InStringMultiLine=true) then
  2489. begin
  2490. if MultiLineStringSuffixLen>2 then
  2491. begin
  2492. if WhiteSpaceLine and IsStringSuffix then
  2493. OnlyStringSuffix:=true;
  2494. end else
  2495. if IsStringMultiLineSuffix then
  2496. begin
  2497. InString:=false;
  2498. InStringMultiLine:=false;
  2499. end;
  2500. end
  2501. else if (InAsm) and (C='@') then
  2502. CC:=ccAlpha; { local labels in asm block will be normal words }
  2503. end;
  2504. if MatchedSymbol and (InComment=false) then
  2505. SymbolConcat:='';
  2506. LastCC:=CC;
  2507. WhiteSpaceLine:=WhiteSpaceLine and ((CC=ccWhiteSpace) or (CC=ccTab));
  2508. end;
  2509. end;
  2510. var Line,NextLine,PrevLine{,OldLine}: PCustomLine;
  2511. PrevLI,LI,nextLI: PEditorLineInfo;
  2512. begin
  2513. if (not Editor^.IsFlagSet(efSyntaxHighlight)) or (FromLine>=GetLineCount) then
  2514. begin
  2515. SetLineFormat(Editor,FromLine,'');
  2516. DoUpdateAttrs:=GetLineCount;
  2517. {$ifdef TEST_PARTIAL_SYNTAX}
  2518. LastSyntaxedLine:=GetLineCount;
  2519. if not SyntaxComplete then
  2520. begin
  2521. SyntaxComplete:=true;
  2522. DoSyntaxStateChanged;
  2523. end;
  2524. (* { no Idle necessary }
  2525. EventMask:=EventMask and not evIdle;*)
  2526. {$endif TEST_PARTIAL_SYNTAX}
  2527. Editor^.SyntaxStateChanged;
  2528. Exit;
  2529. end;
  2530. {$ifdef TEST_PARTIAL_SYNTAX}
  2531. If Editor^.IsFlagSet(efSyntaxHighlight) and (LastSyntaxedLine<FromLine)
  2532. and (FromLine<GetLineCount) then
  2533. CurLineNr:=LastSyntaxedLine
  2534. else
  2535. {$endif TEST_PARTIAL_SYNTAX}
  2536. CurLineNr:=FromLine;
  2537. if CurLineNr>0 then
  2538. PrevLine:=GetLine(CurLineNr-1)
  2539. else
  2540. PrevLine:=nil;
  2541. CommentStartY:=CurLineNr-1; { use in detection for false positive commment: (*) }
  2542. repeat
  2543. Line:=GetLine(CurLineNr);
  2544. if Assigned(PrevLine) then PrevLI:=PrevLine^.GetEditorInfo(Editor) else PrevLI:=nil;
  2545. if Assigned(Line) then LI:=Line^.GetEditorInfo(Editor) else LI:=nil;
  2546. InSingleLineComment:=false;
  2547. if PrevLI<>nil then
  2548. begin
  2549. InString:=PrevLI^.EndsWithString;
  2550. MultiLineStringSuffixLen:=PrevLI^.EndsWithMultiLineStringSuffixLen;
  2551. InAsm:=PrevLI^.EndsWithAsm;
  2552. InComment:=PrevLI^.EndsWithComment and not PrevLI^.EndsInSingleLineComment;
  2553. CurrentCommentType:=PrevLI^.EndCommentType;
  2554. CurrentCommentDepth:=PrevLI^.EndCommentDepth;
  2555. NestedComments:=(PrevLI^.EndNestedComments and 1)=1;
  2556. LookForNestedComments:=(PrevLI^.EndNestedComments and 2)=2;
  2557. InDirective:=PrevLI^.EndsWithDirective;
  2558. end
  2559. else
  2560. begin
  2561. InString:=false;
  2562. MultiLineStringSuffixLen:=0;
  2563. InAsm:=false;
  2564. InComment:=false;
  2565. CurrentCommentType:=0;
  2566. CurrentCommentDepth:=0;
  2567. InDirective:=false;
  2568. NestedComments:=false;
  2569. LookForNestedComments:=false;
  2570. end;
  2571. { OldLine:=Line;}
  2572. if (not Editor^.IsFlagSet(efKeepLineAttr)) then
  2573. begin
  2574. LI^.BeginsWithString:=InString;
  2575. LI^.BeginsWithMultiLineStringSuffixLen:=MultiLineStringSuffixLen;
  2576. LI^.BeginsWithAsm:=InAsm;
  2577. LI^.BeginsWithComment:=InComment;
  2578. LI^.BeginsWithDirective:=InDirective;
  2579. LI^.BeginCommentType:=CurrentCommentType;
  2580. LI^.BeginCommentDepth:=CurrentCommentDepth;
  2581. LI^.BeginNestedComments:=byte(NestedComments) and 1;
  2582. LI^.BeginNestedComments:=LI^.BeginNestedComments or ((byte(LookForNestedComments)and 1) shl 1);
  2583. end
  2584. else
  2585. begin
  2586. InString:=LI^.BeginsWithString;
  2587. MultiLineStringSuffixLen:=LI^.BeginsWithMultiLineStringSuffixLen;
  2588. InAsm:=LI^.BeginsWithAsm;
  2589. InComment:=LI^.BeginsWithComment;
  2590. InDirective:=LI^.BeginsWithDirective;
  2591. CurrentCommentType:=LI^.BeginCommentType;
  2592. CurrentCommentDepth:=LI^.BeginCommentDepth;
  2593. NestedComments:=(LI^.BeginNestedComments and 1)=1;
  2594. LookForNestedComments:=(LI^.BeginNestedComments and 2)=2;
  2595. end;
  2596. LineText:=GetLineText(CurLineNr);
  2597. Format:=CharStr(chr(coTextColor),length(LineText));
  2598. LastCC:=ccWhiteSpace;
  2599. ClassStart:=1;
  2600. SymbolConcat:='';
  2601. SymbolWord:='';
  2602. OnlyStringSuffix:=false;
  2603. StringSuffixEnded:=false;
  2604. InStringMultiLine:=InString;
  2605. WhiteSpaceLine:=true;
  2606. if LineText<>'' then
  2607. begin
  2608. for X:=1 to length(LineText) do
  2609. ProcessChar(LineText[X]);
  2610. Inc(X);
  2611. ProcessChar(' ');
  2612. if (not InString) and (MultiLineStringSuffixLen>0) then
  2613. MultiLineStringSuffixLen:=0;
  2614. if InString and not InStringMultiLine then
  2615. begin
  2616. MultiLineStringSuffixLen:=GetMultiLineStringSuffixLen;
  2617. if MultiLineStringSuffixLen>2 then
  2618. InStringMultiLine:=true;
  2619. end;
  2620. end;
  2621. SetLineFormat(Editor,CurLineNr,Format);
  2622. LI^.EndsWithMultiLineStringSuffixLen:=MultiLineStringSuffixLen;
  2623. LI^.EndsWithString:=InStringMultiLine;
  2624. LI^.EndsWithAsm:=InAsm;
  2625. LI^.EndsWithComment:=InComment;
  2626. LI^.EndsInSingleLineComment:=InSingleLineComment;
  2627. LI^.EndNestedComments:=byte(NestedComments) and 1;
  2628. LI^.EndNestedComments:=LI^.EndNestedComments or ((byte(LookForNestedComments)and 1) shl 1);
  2629. LI^.EndCommentDepth:=CurrentCommentDepth;
  2630. LI^.EndCommentType:=CurrentCommentType;
  2631. LI^.EndsWithDirective:=InDirective;
  2632. Inc(CurLineNr);
  2633. if CurLineNr>=GetLineCount then
  2634. Break;
  2635. NextLine:=GetLine(CurLineNr);
  2636. if Assigned(NextLine) then NextLI:=NextLine^.GetEditorInfo(Editor) else NextLI:=nil;
  2637. if ((Attrs and attrForceFull)=0) then
  2638. if (* Why should we go
  2639. (InAsm=false) and (NextLI^.BeginsWithAsm=false) and
  2640. (InComment=false) and (NextLI^.BeginsWithComment=false) and
  2641. (InDirective=false) and (NextLI^.BeginsWithDirective=false) and
  2642. { OldLine = Line so this is nonsense}
  2643. (PrevLI^.EndsWithComment=LI^.EndsWithComment) and
  2644. (PrevLI^.EndsWithAsm=LI^.EndsWithAsm) and
  2645. (PrevLI^.EndsWithDirective=LI^.EndsWithDirective) and *)
  2646. {$ifdef TEST_PARTIAL_SYNTAX}
  2647. (CurLineNr>FromLine) and
  2648. {$endif TEST_PARTIAL_SYNTAX}
  2649. (NextLI^.BeginsWithString=LI^.EndsWithString) and
  2650. (NextLI^.BeginsWithMultiLineStringSuffixLen=LI^.EndsWithMultiLineStringSuffixLen) and
  2651. (NextLI^.BeginsWithAsm=LI^.EndsWithAsm) and
  2652. (NextLI^.BeginsWithComment=LI^.EndsWithComment) and
  2653. (NextLI^.BeginsWithDirective=LI^.EndsWithDirective) and
  2654. (NextLI^.BeginCommentType=LI^.EndCommentType) and
  2655. (NextLI^.BeginNestedComments=LI^.EndNestedComments) and
  2656. (NextLI^.BeginCommentDepth=LI^.EndCommentDepth) and
  2657. (Length(NextLI^.GetFormat)>0) then
  2658. Break;
  2659. {$ifdef TEST_PARTIAL_SYNTAX}
  2660. if (CurLineNr<GetLineCount) and
  2661. (CurLineNr>FromLine) and
  2662. ((Attrs and attrForceFull)=0) and
  2663. (CurLineNr>GetLastVisibleLine) then
  2664. begin
  2665. If SyntaxComplete then
  2666. begin
  2667. SyntaxComplete:=false;
  2668. DoSyntaxStateChanged;
  2669. end;
  2670. LastSyntaxedLine:=CurLineNr-1;
  2671. break;
  2672. end;
  2673. {$endif TEST_PARTIAL_SYNTAX}
  2674. PrevLine:=Line;
  2675. until false;
  2676. DoUpdateAttrs:=CurLineNr;
  2677. {$ifdef TEST_PARTIAL_SYNTAX}
  2678. If LastSyntaxedLine<CurLineNr-1 then
  2679. LastSyntaxedLine:=CurLineNr-1;
  2680. if CurLineNr=GetLineCount then
  2681. begin
  2682. SyntaxComplete:=true;
  2683. DoSyntaxStateChanged;
  2684. end;
  2685. {$endif TEST_PARTIAL_SYNTAX}
  2686. end;
  2687. function TCustomCodeEditorCore.DoUpdateAttrsRange(Editor: PCustomCodeEditor; FromLine, ToLine: sw_integer;
  2688. Attrs: byte): sw_integer;
  2689. var Line: Sw_integer;
  2690. begin
  2691. Lock(Editor);
  2692. Line:=FromLine;
  2693. repeat
  2694. Line:=DoUpdateAttrs(Editor,Line,Attrs);
  2695. until (Line>=GetLineCount) or (Line>ToLine);
  2696. DoUpdateAttrsRange:=Line;
  2697. Unlock(Editor);
  2698. end;
  2699. procedure TCustomCodeEditorCore.AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: sw_astring;AFlags : longint);
  2700. begin
  2701. Abstract;
  2702. end;
  2703. procedure TCustomCodeEditorCore.AddGroupedAction(AAction : byte);
  2704. begin
  2705. Abstract;
  2706. end;
  2707. procedure TCustomCodeEditorCore.CloseGroupedAction(AAction : byte);
  2708. begin
  2709. Abstract;
  2710. end;
  2711. function TCustomCodeEditorCore.GetUndoActionCount: sw_integer;
  2712. begin
  2713. Abstract;
  2714. GetUndoActionCount:=0;
  2715. end;
  2716. function TCustomCodeEditorCore.GetRedoActionCount: sw_integer;
  2717. begin
  2718. Abstract;
  2719. GetRedoActionCount:=0;
  2720. end;
  2721. destructor TCustomCodeEditorCore.Done;
  2722. begin
  2723. {$ifdef DEBUG}
  2724. if Bindings^.Count>0 then
  2725. ErrorBox('Internal error: there are still '+IntToStr(Bindings^.Count)+' editors '+
  2726. 'registered at TCodeEditorCode.Done!!!',nil);
  2727. {$endif}
  2728. if Assigned(Bindings) then Dispose(Bindings, Done); Bindings:=nil;
  2729. inherited Done;
  2730. end;
  2731. procedure TCustomCodeEditor.Lock;
  2732. begin
  2733. Inc(ELockFlag);
  2734. LockScreenUpdate;
  2735. end;
  2736. procedure TCustomCodeEditor.UnLock;
  2737. begin
  2738. {$ifdef DEBUG}
  2739. if Elockflag=0 then
  2740. Bug('negative lockflag',nil)
  2741. else
  2742. {$endif DEBUG}
  2743. UnlockScreenUpdate;
  2744. Dec(ELockFlag);
  2745. if (ELockFlag>0) then
  2746. Exit;
  2747. if DrawCalled then
  2748. DrawView;
  2749. If DrawCursorCalled then
  2750. Begin
  2751. DrawCursor;
  2752. DrawCursorCalled:=false;
  2753. End;
  2754. end;
  2755. procedure TCustomCodeEditor.DrawIndicator;
  2756. begin
  2757. { Abstract }
  2758. end;
  2759. procedure TCustomCodeEditor.AdjustSelectionPos(OldCurPosX, OldCurPosY: sw_integer; DeltaX, DeltaY: sw_integer);
  2760. var CP: TPoint;
  2761. begin
  2762. if ValidBlock=false then Exit;
  2763. CP.X:=OldCurPosX; CP.Y:=OldCurPosY;
  2764. if (PosToOfsP(SelStart)<=PosToOfsP(CP)) and (PosToOfsP(CP)<PosToOfsP(SelEnd)) then
  2765. begin
  2766. { OldCurPos is IN selection }
  2767. if (CP.Y=SelEnd.Y) then
  2768. begin
  2769. if ((SelStart.Y<>SelEnd.Y) or (SelStart.X<=CP.X)) and
  2770. (CP.X<=SelEnd.X) then
  2771. Inc(SelEnd.X,DeltaX);
  2772. end
  2773. else if (CP.Y=SelEnd.Y+DeltaY) then
  2774. Inc(SelEnd.X,DeltaX);
  2775. Inc(SelEnd.Y,DeltaY);
  2776. SelectionChanged;
  2777. end
  2778. else
  2779. if (PosToOfsP(CP)<=PosToOfsP(SelStart)) then
  2780. begin
  2781. { OldCurPos is BEFORE selection }
  2782. if (CP.Y=SelStart.Y) and (CP.Y=SelEnd.Y) and (DeltaY<0) then
  2783. begin
  2784. SelStart:=CurPos; SelEnd:=CurPos;
  2785. end
  2786. else
  2787. if (CP.Y=SelStart.Y) then
  2788. begin
  2789. if CP.X<SelStart.X then
  2790. Inc(SelStart.X,DeltaX);
  2791. end;
  2792. { else}
  2793. begin
  2794. Inc(SelStart.Y,DeltaY);
  2795. Inc(SelEnd.Y,DeltaY);
  2796. end;
  2797. if SelEnd.Y=CurPos.Y then Inc(SelEnd.X,DeltaX);
  2798. SelectionChanged;
  2799. end
  2800. else
  2801. begin
  2802. { OldCurPos is AFTER selection }
  2803. { actually we don't have to do anything here }
  2804. end;
  2805. end;
  2806. function TCustomCodeEditor.GetFlags: longint;
  2807. begin
  2808. { Abstract }
  2809. GetFlags:=0;
  2810. end;
  2811. procedure TCustomCodeEditor.SetFlags(AFlags: longint);
  2812. begin
  2813. { Abstract }
  2814. end;
  2815. function TCustomCodeEditor.GetModified: boolean;
  2816. begin
  2817. { Abstract }
  2818. GetModified:=true;
  2819. end;
  2820. procedure TCustomCodeEditor.SetModified(AModified: boolean);
  2821. begin
  2822. { Abstract }
  2823. end;
  2824. function TCustomCodeEditor.GetStoreUndo: boolean;
  2825. begin
  2826. { Abstract }
  2827. GetStoreUndo:=false;
  2828. end;
  2829. procedure TCustomCodeEditor.SetStoreUndo(AStore: boolean);
  2830. begin
  2831. { Abstract }
  2832. end;
  2833. function TCustomCodeEditor.GetSyntaxCompleted: boolean;
  2834. begin
  2835. { Abstract }
  2836. GetSyntaxCompleted:=true;
  2837. end;
  2838. procedure TCustomCodeEditor.SetSyntaxCompleted(SC : boolean);
  2839. begin
  2840. { Abstract }
  2841. end;
  2842. function TCustomCodeEditor.GetLastSyntaxedLine: sw_integer;
  2843. begin
  2844. Abstract;
  2845. GetLastSyntaxedLine:=0;
  2846. end;
  2847. procedure TCustomCodeEditor.SetLastSyntaxedLine(ALine: sw_integer);
  2848. begin
  2849. Abstract;
  2850. end;
  2851. function TCustomCodeEditor.IsNestedComments(X,Y : sw_integer): boolean;
  2852. begin
  2853. IsNestedComments:=false; {default behavior is no nested comments}
  2854. end;
  2855. function TCustomCodeEditor.NestedCommentsChangeCheck(CurLine : sw_integer):boolean;
  2856. begin
  2857. NestedCommentsChangeCheck:=false;
  2858. end;
  2859. function TCustomCodeEditor.IsFlagSet(AFlag: longint): boolean;{$ifdef USEINLINE}inline;{$endif}
  2860. begin
  2861. IsFlagSet:=(GetFlags and AFlag)=AFlag;
  2862. end;
  2863. function TCustomCodeEditor.GetTabSize: integer;
  2864. begin
  2865. { Abstract }
  2866. GetTabSize:=5;
  2867. end;
  2868. procedure TCustomCodeEditor.SetTabSize(ATabSize: integer);
  2869. begin
  2870. { Abstract }
  2871. end;
  2872. function TCustomCodeEditor.GetIndentSize: integer;
  2873. begin
  2874. { Abstract }
  2875. GetIndentSize:=1;
  2876. end;
  2877. procedure TCustomCodeEditor.SetIndentSize(AIndentSize: integer);
  2878. begin
  2879. { Abstract }
  2880. end;
  2881. function TCustomCodeEditor.IsReadOnly: boolean;
  2882. begin
  2883. { Abstract }
  2884. IsReadOnly:=false;
  2885. end;
  2886. function TCustomCodeEditor.IsClipboard: Boolean;
  2887. begin
  2888. { Abstract }
  2889. IsClipboard:=false;
  2890. end;
  2891. function TCustomCodeEditor.GetMaxDisplayLength: sw_integer;
  2892. begin
  2893. Abstract;
  2894. GetMaxDisplayLength:=0;
  2895. end;
  2896. function TCustomCodeEditor.GetLineCount: sw_integer;
  2897. begin
  2898. Abstract;
  2899. GetLineCount:=0;
  2900. end;
  2901. function TCustomCodeEditor.GetLine(LineNo: sw_integer): PCustomLine;
  2902. begin
  2903. Abstract;
  2904. GetLine:=nil;
  2905. end;
  2906. function TCustomCodeEditor.CharIdxToLinePos(Line,CharIdx: sw_integer): sw_integer;
  2907. begin
  2908. Abstract;
  2909. CharIdxToLinePos:=0;
  2910. end;
  2911. function TCustomCodeEditor.LinePosToCharIdx(Line,X: sw_integer): sw_integer;
  2912. begin
  2913. Abstract;
  2914. LinePosToCharIdx:=0;
  2915. end;
  2916. function TCustomCodeEditor.GetLineText(I: sw_integer): sw_astring;
  2917. begin
  2918. Abstract;
  2919. GetLineText:='';
  2920. end;
  2921. procedure TCustomCodeEditor.SetDisplayText(I: sw_integer;const S: sw_astring);
  2922. begin
  2923. Abstract;
  2924. end;
  2925. function TCustomCodeEditor.GetDisplayText(I: sw_integer): sw_astring;
  2926. begin
  2927. Abstract;
  2928. GetDisplayText:='';
  2929. end;
  2930. procedure TCustomCodeEditor.SetLineText(I: sw_integer;const S: sw_AString);
  2931. begin
  2932. Abstract;
  2933. end;
  2934. procedure TCustomCodeEditor.GetDisplayTextFormat(I: sw_integer;var DT,DF:sw_astring);
  2935. begin
  2936. Abstract;
  2937. end;
  2938. function TCustomCodeEditor.GetLineFormat(I: sw_integer): sw_astring;
  2939. begin
  2940. { Abstract }
  2941. GetLineFormat:='';
  2942. end;
  2943. procedure TCustomCodeEditor.SetLineFormat(I: sw_integer;const S: sw_astring);
  2944. begin
  2945. { Abstract }
  2946. end;
  2947. procedure TCustomCodeEditor.DeleteAllLines;
  2948. begin
  2949. Abstract;
  2950. end;
  2951. procedure TCustomCodeEditor.DeleteLine(I: sw_integer);
  2952. begin
  2953. Abstract;
  2954. end;
  2955. function TCustomCodeEditor.InsertLine(LineNo: sw_integer; const S: sw_astring): PCustomLine;
  2956. begin
  2957. Abstract;
  2958. InsertLine:=nil; { eliminate compiler warning }
  2959. end;
  2960. procedure TCustomCodeEditor.AddLine(const S: sw_astring);
  2961. begin
  2962. Abstract;
  2963. end;
  2964. function TCustomCodeEditor.GetErrorMessage: string;
  2965. begin
  2966. Abstract;
  2967. GetErrorMessage:='';
  2968. end;
  2969. procedure TCustomCodeEditor.SetErrorMessage(const S: string);
  2970. begin
  2971. Abstract;
  2972. end;
  2973. procedure TCustomCodeEditor.GetContent(ALines: PUnsortedStringCollection);
  2974. begin
  2975. Abstract;
  2976. end;
  2977. procedure TCustomCodeEditor.SetContent(ALines: PUnsortedStringCollection);
  2978. begin
  2979. Abstract;
  2980. end;
  2981. function TCustomCodeEditor.LoadFromStream(Stream: PFastBufStream): boolean;
  2982. begin
  2983. Abstract;
  2984. LoadFromStream:=false;
  2985. end;
  2986. function TCustomCodeEditor.SaveToStream(Stream: PStream): boolean;
  2987. var A,B: TPoint;
  2988. begin
  2989. A.Y:=0; A.X:=0;
  2990. B.Y:=GetLineCount-1;
  2991. if GetLineCount>0 then
  2992. B.X:=length(GetDisplayText(B.Y))
  2993. else
  2994. B.X:=0;
  2995. SaveToStream:=SaveAreaToStream(Stream,A,B);
  2996. end;
  2997. function TCustomCodeEditor.SaveAreaToStream(Stream: PStream; StartP,EndP: TPoint): boolean;
  2998. begin
  2999. Abstract;
  3000. SaveAreaToStream:=false;
  3001. end;
  3002. function TCustomCodeEditor.LoadFromFile(const AFileName: string): boolean;
  3003. var S: PFastBufStream;
  3004. OK: boolean;
  3005. begin
  3006. New(S, Init(AFileName,stOpenRead,EditorTextBufSize));
  3007. OK:=Assigned(S);
  3008. {$ifdef TEST_PARTIAL_SYNTAX}
  3009. SetSyntaxCompleted(false);
  3010. { Idle necessary }
  3011. EventMask:=EventMask or evIdle;
  3012. {$endif TEST_PARTIAL_SYNTAX}
  3013. if OK then OK:=LoadFromStream(S);
  3014. if Assigned(S) then Dispose(S, Done);
  3015. LoadFromFile:=OK;
  3016. end;
  3017. function TCustomCodeEditor.SaveToFile(const AFileName: string): boolean;
  3018. var OK: boolean;
  3019. S: PBufStream;
  3020. begin
  3021. New(S, Init(AFileName,stCreate,EditorTextBufSize));
  3022. OK:=Assigned(S) and (S^.Status=stOK);
  3023. if OK then OK:=SaveToStream(S);
  3024. if Assigned(S) then Dispose(S, Done);
  3025. SaveToFile:=OK;
  3026. end;
  3027. procedure TCustomCodeEditor.AdjustBookMark(X, NewX, Y, NewY: sw_integer);
  3028. var P : PEditorBookMark;
  3029. Count,Index : sw_integer;
  3030. Line,NewLine : PCustomLine;
  3031. begin
  3032. if NewY=Y then
  3033. GetLine(Y)^.AdjustMark(@Self,X,NewX-X)
  3034. else
  3035. begin
  3036. Line:=GetLine(Y);
  3037. Count:=Line^.MarkCount(@Self);
  3038. if Count > 0 then
  3039. begin
  3040. NewLine:=GetLine(NewY);
  3041. for Index:=Count-1 downto 0 do
  3042. begin
  3043. P:=Line^.GetMark(@Self,Index);
  3044. if P^.Pos.X>=X then
  3045. begin
  3046. P^.Pos.X:=Max(0,P^.Pos.X+(NewX-X));
  3047. Line^.DeleteMark(@Self,P);
  3048. NewLine^.InsertMark(@Self,P);
  3049. end;
  3050. end;
  3051. end;
  3052. end;
  3053. end;
  3054. function TCustomCodeEditor.InsertFrom(Editor: PCustomCodeEditor): Boolean;
  3055. var OK: boolean;
  3056. CP,CI,RX,RSX,LineDelta,LineCount: Sw_integer;
  3057. StartPos,DestPos,BPos,EPos: TPoint;
  3058. LineStartX,LineEndX: Sw_integer;
  3059. TabSize,CharIdxStart,CharIdxEnd: Sw_integer;
  3060. S,DS,BeforeS,OrigS,AfterS: sw_astring;
  3061. VerticalBlock: boolean;
  3062. SEnd: TPoint;
  3063. begin
  3064. if Editor^.IsFlagSet(efVerticalBlocks) then
  3065. begin
  3066. NotImplemented;
  3067. Exit;
  3068. end;
  3069. Lock;
  3070. { every data in the clipboard gets a new line }
  3071. if (Clipboard=@Self) and (CurPos.X>0) then
  3072. InsertNewLine;
  3073. OK:=(Editor^.SelStart.X<>Editor^.SelEnd.X) or (Editor^.SelStart.Y<>Editor^.SelEnd.Y);
  3074. if OK then
  3075. begin
  3076. if not (Clipboard=@Self) and IsFlagSet(efOverwriteBlocks) and InSelectionArea then
  3077. DelSelect; {delete selection before paste}
  3078. CI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
  3079. CurPos.X:=CharIdxToLinePos(CurPos.Y,CI); {tab space adjustment}
  3080. StartPos:=CurPos; DestPos:=CurPos;
  3081. EPos:=CurPos;
  3082. VerticalBlock:=Editor^.IsFlagSet(efVerticalBlocks);
  3083. LineDelta:=0; LineCount:=(Editor^.SelEnd.Y-Editor^.SelStart.Y)+1;
  3084. OK:=GetLineCount<MaxLineCount;
  3085. OrigS:=GetLineText(DestPos.Y);
  3086. BeforeS:=Copy(OrigS,1,LinePosToCharIdx(DestPos.Y,DestPos.X-1));
  3087. { we might need to add some spaces here,
  3088. but how many ? }
  3089. TabSize:=GetTabSize;
  3090. CP:=1; RX:=0;
  3091. while (CP<=length(BeforeS)) do
  3092. begin
  3093. if (BeforeS[CP]=TAB) then
  3094. Inc(RX,TabSize-(RX mod TabSize))
  3095. else
  3096. Inc(RX);
  3097. Inc(CP);
  3098. end;
  3099. BeforeS:=BeforeS+CharStr(' ',DestPos.X-RX);
  3100. AfterS:=Copy(OrigS,LinePosToCharIdx(DestPos.Y,DestPos.X),Length(OrigS));
  3101. BPos:=CurPos;
  3102. while OK and (LineDelta<LineCount) do
  3103. begin
  3104. S:=Editor^.GetLineText(Editor^.SelStart.Y+LineDelta);
  3105. if (LineDelta>0) and (VerticalBlock=false) then
  3106. begin
  3107. InsertLine(DestPos.Y,'');
  3108. EPOS.X:=0;EPos.Y:=DestPos.Y;
  3109. AddAction(eaInsertLine,BPos,EPos,'',GetFlags);
  3110. LimitsChanged;
  3111. end;
  3112. If LineDelta>0 then
  3113. BeforeS:='';
  3114. if (LineDelta=0) or VerticalBlock then
  3115. LineStartX:=Editor^.SelStart.X
  3116. else
  3117. LineStartX:=0;
  3118. if (LineDelta=LineCount-1) or VerticalBlock then
  3119. begin
  3120. LineEndX:=Editor^.SelEnd.X-1;
  3121. CharIdxEnd:=Editor^.LinePosToCharIdx(Editor^.SelStart.Y+LineDelta,LineEndX);
  3122. end
  3123. else
  3124. begin
  3125. LineEndX:=Length(S);
  3126. CharIdxEnd:=LineEndX;
  3127. end;
  3128. CharIdxStart:=Editor^.LinePosToCharIdx(Editor^.SelStart.Y+LineDelta,LineStartX);
  3129. if LineEndX<LineStartX then
  3130. S:=''
  3131. else if VerticalBlock then
  3132. begin
  3133. S:=copy(S,CharIdxStart,CharIdxEnd-CharIdxStart+1);
  3134. S:=RExpand(S,Min(CharIdxEnd-CharIdxStart+1,Length(S)));
  3135. end else
  3136. S:=copy(S,CharIdxStart,CharIdxEnd-CharIdxStart+1);
  3137. if VerticalBlock=false then
  3138. begin
  3139. DS:=BeforeS+S;
  3140. CP:=1; RX:=0;
  3141. RSX :=0;
  3142. while (CP<=length(DS)) do
  3143. begin
  3144. if (DS[CP]=TAB) then
  3145. Inc(RX,TabSize-(RX mod TabSize))
  3146. else
  3147. Inc(RX);
  3148. if CP=length(BeforeS) then
  3149. RSX:=RX;
  3150. Inc(CP);
  3151. end;
  3152. if LineDelta=LineCount-1 then
  3153. begin
  3154. SetLineText(DestPos.Y,DS+AfterS);
  3155. BPos.X:=DestPos.X;BPos.Y:=DestPos.Y;
  3156. EPOS.X:=DestPos.X+RX-RSX;EPos.Y:=DestPos.Y;
  3157. AddAction(eaInsertText,BPos,EPos,S,GetFlags);
  3158. end
  3159. else
  3160. begin
  3161. SetLineText(DestPos.Y,DS);
  3162. BPos.X:=DestPos.X;BPos.Y:=DestPos.Y;
  3163. EPOS.X:=DestPos.X+RX-RSX;EPos.Y:=DestPos.Y;
  3164. AddAction(eaInsertText,BPos,EPos,S,GetFlags);
  3165. end;
  3166. BPos.X:=EPos.X;
  3167. if LineDelta=LineCount-1 then
  3168. begin
  3169. SEnd.Y:=DestPos.Y;
  3170. SEnd.X:=DestPos.X+RX-RSX;
  3171. end
  3172. else
  3173. begin
  3174. Inc(DestPos.Y);
  3175. DestPos.X:=0;
  3176. end;
  3177. end
  3178. else { if VerticalBlock=false then .. else }
  3179. begin
  3180. { this is not yet implemented !! PM }
  3181. S:=RExpand(S,LineEndX-LineStartX+1);
  3182. end;
  3183. Inc(LineDelta);
  3184. OK:=GetLineCount<MaxLineCount;
  3185. end;
  3186. if not OK then EditorDialog(edTooManyLines,nil);
  3187. { mainly to force eaMove insertion }
  3188. if not IsClipboard then
  3189. SetCurPtr(EPos.X,EPos.Y);
  3190. SetCurPtr(StartPos.X,StartPos.Y);
  3191. UpdateAttrs(StartPos.Y,attrAll);
  3192. SetModified(true);
  3193. LimitsChanged;
  3194. SetSelection(CurPos,SEnd);
  3195. if IsClipboard then
  3196. begin
  3197. Inc(DestPos.X,length(S));
  3198. SetCurPtr(DestPos.X,DestPos.Y);
  3199. end;
  3200. DrawView;
  3201. end;
  3202. UnLock;
  3203. InsertFrom:=OK;
  3204. end;
  3205. function TCustomCodeEditor.InsertText(const S: sw_astring): Boolean;
  3206. var I,CI: sw_integer;
  3207. OldPos: TPoint;
  3208. HoldUndo : boolean;
  3209. WasAutoBrackets : boolean;
  3210. begin
  3211. Lock;
  3212. CI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
  3213. CurPos.X:=CharIdxToLinePos(CurPos.Y,CI); {tab space adjustment}
  3214. OldPos:=CurPos;
  3215. HoldUndo:=GetStoreUndo;
  3216. WasAutoBrackets:=GetAutoBrackets;
  3217. SetAutoBrackets(false);
  3218. SetStoreUndo(false);
  3219. for I:=1 to length(S) do
  3220. AddChar(S[I]);
  3221. InsertText:=true;
  3222. SetAutoBrackets(WasAutoBrackets);
  3223. SetStoreUndo(HoldUndo);
  3224. AddAction(eaInsertText,OldPos,CurPos,S,GetFlags);
  3225. UnLock;
  3226. end;
  3227. procedure TCustomCodeEditor.ModifiedChanged;
  3228. begin
  3229. { Abstract }
  3230. end;
  3231. procedure TCustomCodeEditor.PositionChanged;
  3232. begin
  3233. { Abstract }
  3234. end;
  3235. procedure TCustomCodeEditor.TabSizeChanged;
  3236. begin
  3237. { Abstract }
  3238. end;
  3239. procedure TCustomCodeEditor.SyntaxStateChanged;
  3240. begin
  3241. { Abstract }
  3242. end;
  3243. procedure TCustomCodeEditor.StoreUndoChanged;
  3244. begin
  3245. { Abstract }
  3246. end;
  3247. function TCustomCodeEditor.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
  3248. begin
  3249. { Abstract }
  3250. GetSpecSymbolCount:=0;
  3251. end;
  3252. function TCustomCodeEditor.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring;
  3253. begin
  3254. Abstract;
  3255. GetSpecSymbol:=nil;
  3256. end;
  3257. function TCustomCodeEditor.IsReservedWord(const S: string): boolean;
  3258. begin
  3259. { Abstract }
  3260. IsReservedWord:=false;
  3261. end;
  3262. function TCustomCodeEditor.IsAsmReservedWord(const S: string): boolean;
  3263. begin
  3264. { Abstract }
  3265. IsAsmReservedWord:=false;
  3266. end;
  3267. function TCustomCodeEditor.TranslateCodeTemplate(var Shortcut: string; ALines: PUnsortedStringCollection): boolean;
  3268. begin
  3269. { Abstract }
  3270. TranslateCodeTemplate:=false;
  3271. end;
  3272. function TCustomCodeEditor.CompleteCodeWord(const WordS: string; var Text: string): boolean;
  3273. begin
  3274. { Abstract }
  3275. Text:='';
  3276. CompleteCodeWord:=false;
  3277. end;
  3278. function TCustomCodeEditor.GetCodeCompleteWord: string;
  3279. begin
  3280. { Abstract }
  3281. GetCodeCompleteWord:='';
  3282. end;
  3283. function TCustomCodeEditor.CreateFold(StartY,EndY: sw_integer; Collapsed: boolean): boolean;
  3284. var F,ParentF: PFold;
  3285. L: PCustomLine;
  3286. EI: PEditorLineInfo;
  3287. Y: sw_integer;
  3288. OK: boolean;
  3289. begin
  3290. OK:=true;
  3291. Lock;
  3292. for Y:=StartY to EndY do
  3293. begin
  3294. L:=GetLine(Y);
  3295. if assigned(L) then
  3296. EI:=L^.GetEditorInfo(@Self)
  3297. else
  3298. begin
  3299. CreateFold:=False;
  3300. exit;
  3301. end;
  3302. if Y=StartY then
  3303. ParentF:=EI^.Fold
  3304. else
  3305. OK:=OK and (EI^.Fold=ParentF);
  3306. if not OK then
  3307. Break;
  3308. end;
  3309. if OK then
  3310. begin
  3311. New(F, Init(@Self,ParentF,Collapsed));
  3312. for Y:=StartY to EndY do
  3313. GetLine(Y)^.GetEditorInfo(@Self)^.SetFold(F);
  3314. DrawView;
  3315. end;
  3316. UnLock;
  3317. CreateFold:=OK;
  3318. end;
  3319. procedure TCustomCodeEditor.FoldChanged(Fold: PFold);
  3320. var F: PFold;
  3321. I: sw_integer;
  3322. begin
  3323. for I:=0 to GetFoldCount-1 do
  3324. begin
  3325. F:=GetFold(I);
  3326. if F^.ParentFold=Fold then
  3327. FoldChanged(F);
  3328. end;
  3329. if Fold^.IsCollapsed then
  3330. begin
  3331. F:=GetLineFold(CurPos.Y); I:=CurPos.Y;
  3332. if F=Fold then
  3333. begin
  3334. while GetLineFold(I-1)=Fold do
  3335. Dec(I);
  3336. if I<>CurPos.Y then
  3337. SetCurPtr(CurPos.X,I);
  3338. end;
  3339. end;
  3340. DrawView;
  3341. end;
  3342. procedure TCustomCodeEditor.RemoveAllFolds;
  3343. var I: sw_integer;
  3344. L: PCustomLine;
  3345. begin
  3346. for I:=0 to GetLineCount-1 do
  3347. begin
  3348. L:=GetLine(I);
  3349. if not assigned(L) then exit;
  3350. with L^ do
  3351. with GetEditorInfo(@Self)^ do
  3352. SetFold(nil);
  3353. end;
  3354. DrawView;
  3355. end;
  3356. { to be called if CurPos has already been changed }
  3357. procedure TCustomCodeEditor.AdjustSelection(DeltaX, DeltaY: sw_integer);
  3358. begin
  3359. AdjustSelectionPos(CurPos.X-DeltaX,CurPos.Y-DeltaY,DeltaX,DeltaY);
  3360. end;
  3361. { to be called if CurPos has not yet been changed }
  3362. procedure TCustomCodeEditor.AdjustSelectionBefore(DeltaX, DeltaY: sw_integer);
  3363. begin
  3364. AdjustSelectionPos(CurPos.X,CurPos.Y,DeltaX,DeltaY);
  3365. end;
  3366. procedure TCustomCodeEditor.TrackCursor(centre:Tcentre);
  3367. var D,CP: TPoint;
  3368. begin
  3369. D:=Delta;
  3370. EditorToViewPoint(D,D); EditorToViewPoint(CurPos,CP);
  3371. if CP.Y<Delta.Y then D.Y:=CP.Y else
  3372. if CP.Y>Delta.Y+Size.Y-1 then D.Y:=CP.Y-Size.Y+1;
  3373. if CP.X<Delta.X then D.X:=CP.X else
  3374. if CP.X>Delta.X+Size.X-1 then D.X:=CP.X-Size.X+1;
  3375. if {((Delta.X<>D.X) or (Delta.Y<>D.Y)) and }centre=do_centre then
  3376. begin
  3377. { loose centering for debugger PM }
  3378. while (CP.Y-D.Y)<(Size.Y div 3) do Dec(D.Y);
  3379. while (CP.Y-D.Y)>2*(Size.Y div 3) do Inc(D.Y);
  3380. end;
  3381. ViewToEditorPoint(D,D);
  3382. if (Delta.X<>D.X) or (Delta.Y<>D.Y) then
  3383. ScrollTo(D.X,D.Y);
  3384. DrawCursor;
  3385. end;
  3386. procedure TCustomCodeEditor.ScrollTo(X, Y: sw_Integer);
  3387. begin
  3388. inherited ScrollTo(X,Y);
  3389. if (HScrollBar=nil) then Delta.X:=Max(X,0);
  3390. if (VScrollBar=nil) then Delta.Y:=Max(Min(Y,GetLineCount-1),0);
  3391. if (HScrollBar=nil) or (VScrollBar=nil) then DrawView;
  3392. end;
  3393. function TCustomCodeEditor.IsModal: boolean;
  3394. var IsM: boolean;
  3395. begin
  3396. IsM:=GetState(sfModal);
  3397. if Assigned(Owner) then
  3398. IsM:=IsM or Owner^.GetState(sfModal);
  3399. IsModal:=IsM;
  3400. end;
  3401. procedure TCustomCodeEditor.FlagsChanged(OldFlags: longint);
  3402. var I: sw_integer;
  3403. begin
  3404. Lock;
  3405. if ((OldFlags xor GetFlags) and efCodeComplete)<>0 then
  3406. ClearCodeCompleteWord;
  3407. SetInsertMode(IsFlagSet(efInsertMode));
  3408. if ((OldFlags xor GetFlags) and efFolds)<>0 then
  3409. if not IsFlagSet(efFolds) then
  3410. RemoveAllFolds;
  3411. if IsFlagSet(efSyntaxHighlight) then
  3412. UpdateAttrs(0,attrAll) else
  3413. for I:=0 to GetLineCount-1 do
  3414. SetLineFormat(I,'');
  3415. DrawView;
  3416. UnLock;
  3417. end;
  3418. procedure TCustomCodeEditor.LimitsChanged;
  3419. begin
  3420. Abstract;
  3421. end;
  3422. procedure TCustomCodeEditor.DoLimitsChanged;
  3423. var DisplayLength : sw_integer;
  3424. begin
  3425. DisplayLength:=((GetMaxDisplayLength+128) shr 6) shl 6;
  3426. DisplayLength:=Min(DisplayLength,MaxLineLength+1);
  3427. SetLimit(DisplayLength,EditorToViewLine(GetLineCount));
  3428. end;
  3429. procedure TCustomCodeEditor.BindingsChanged;
  3430. begin
  3431. { Abstract }
  3432. end;
  3433. procedure TCustomCodeEditor.ContentsChanged;
  3434. begin
  3435. DrawView;
  3436. end;
  3437. procedure TCustomCodeEditor.ConvertEvent(var Event: TEvent);
  3438. var
  3439. Key: Word;
  3440. begin
  3441. if Event.What = evKeyDown then
  3442. begin
  3443. if (Event.KeyShift and kbShift <> 0) and
  3444. (Event.ScanCode >= $47) and (Event.ScanCode <= $51) then
  3445. Event.CharCode := #0;
  3446. Key := Event.KeyCode;
  3447. if KeyState <> 0 then
  3448. begin
  3449. if (Lo(Key) >= $01) and (Lo(Key) <= $1A) then Inc(Key, $40);
  3450. if (Lo(Key) >= $61) and (Lo(Key) <= $7A) then Dec(Key, $20);
  3451. end;
  3452. Key := ScanKeyMap(KeyMap[KeyState], Key);
  3453. if (KeyState<>0) and (Key=0) then
  3454. ClearEvent(Event); { eat second key if unrecognized after ^Q or ^K }
  3455. KeyState := 0;
  3456. if Key <> 0 then
  3457. if Hi(Key) = $FF then
  3458. begin
  3459. KeyState := Lo(Key);
  3460. ClearEvent(Event);
  3461. end
  3462. else
  3463. begin
  3464. Event.What := evCommand;
  3465. Event.Command := Key;
  3466. end;
  3467. end;
  3468. end;
  3469. procedure TCustomCodeEditor.SetLineFlagState(LineNo: sw_integer; Flags: longint; ASet: boolean);
  3470. var L: PCustomLine;
  3471. begin
  3472. { Avoid crashes if file was shorten for instance }
  3473. if LineNo>=GetLineCount then
  3474. exit;
  3475. L:=GetLine(LineNo);
  3476. if Assigned(L) then
  3477. with L^ do
  3478. if ASet then
  3479. SetFlags(GetFlags or Flags)
  3480. else
  3481. SetFlags(GetFlags and not Flags);
  3482. end;
  3483. procedure TCustomCodeEditor.SetLineFlagExclusive(Flags: longint; LineNo: sw_integer);
  3484. var I,Count: sw_integer;
  3485. L: PCustomLine;
  3486. begin
  3487. Lock;
  3488. Count:=GetLineCount;
  3489. for I:=0 to Count-1 do
  3490. begin
  3491. L:=GetLine(I);
  3492. if not assigned(L) then break;
  3493. if I=LineNo then
  3494. L^.SetFlags(L^.GetFlags or Flags)
  3495. else
  3496. L^.SetFlags(L^.GetFlags and (not Flags));
  3497. end;
  3498. UnLock;
  3499. end;
  3500. procedure TCustomCodeEditor.HandleEvent(var Event: TEvent);
  3501. var DontClear : boolean;
  3502. procedure CheckScrollBar(P: PScrollBar; var D: Sw_Integer);
  3503. begin
  3504. if (Event.InfoPtr = P) and (P^.Value <> D) then
  3505. begin
  3506. D := P^.Value;
  3507. DrawView;
  3508. end;
  3509. end;
  3510. procedure GetMousePos(var P: TPoint);
  3511. begin
  3512. MakeLocal(Event.Where,P);
  3513. Inc(P.X,Delta.X); Inc(P.Y,Delta.Y);
  3514. Dec(P.X,GetReservedColCount);
  3515. if P.X<0 then P.X:=0;
  3516. if P.Y<0 then P.Y:=0;
  3517. end;
  3518. type TCCAction = (ccCheck,ccClear,ccDontCare);
  3519. var
  3520. StartP,P,PrevP: TPoint;
  3521. E: TEvent;
  3522. OldEvent : PEvent;
  3523. CCAction: TCCAction;
  3524. begin
  3525. CCAction:=ccClear;
  3526. E:=Event;
  3527. OldEvent:=CurEvent;
  3528. if (E.What and (evMouse or evKeyboard))<>0 then
  3529. CurEvent:=@E;
  3530. if (InASCIIMode=false) or (Event.What<>evKeyDown) then
  3531. if (Event.What<>evKeyDown) or (Event.KeyCode<>kbEnter) or (IsReadOnly=false) then
  3532. if (Event.What<>evKeyDown) or
  3533. ((Event.KeyCode<>kbEnter) and (Event.KeyCode<>kbEsc)) or
  3534. (GetCompleteState<>csOffering) then
  3535. ConvertEvent(Event);
  3536. case Event.What of
  3537. evMouseDown :
  3538. if (Event.Buttons=mbRightButton) then
  3539. begin
  3540. MakeLocal(Event.Where,P); Inc(P.X); Inc(P.Y);
  3541. LocalMenu(P);
  3542. ClearEvent(Event);
  3543. end else
  3544. if (Event.Buttons=mbLeftButton) and not(Event.Double or Event.Triple) then
  3545. begin
  3546. GetMousePos(P);
  3547. StartP:=P;
  3548. SetCurPtr(P.X,P.Y);
  3549. PrevP.X:=-1; { first time previous point is different }
  3550. repeat
  3551. GetMousePos(P);
  3552. if ((P.X<>PrevP.X) or (P.Y<>PrevP.Y)) or (Event.What = evMouseWheel) then
  3553. begin
  3554. Lock;
  3555. if Event.What = evMouseWheel then
  3556. begin
  3557. E:=Event;
  3558. HandleEvent(Event); { do scrolling }
  3559. Event:=E;
  3560. GetMousePos(P); { new mouse position after scroll up/down }
  3561. end;
  3562. SetCurPtr(P.X,P.Y);
  3563. PrevP:=P;
  3564. if PointOfs(P)<PointOfs(StartP)
  3565. then SetSelection(P,StartP)
  3566. else if PointOfs(P)>PointOfs(StartP)
  3567. then SetSelection(StartP,P)
  3568. else if PointOfs(SelStart)<>PointOfs(SelEnd) { if selected only then remove selection }
  3569. then SetSelection(StartP,P);
  3570. DrawView;
  3571. UnLock;
  3572. end;
  3573. until not MouseEvent(Event, evMouseMove+evMouseAuto+evMouseWheel);
  3574. DrawView;
  3575. ClearEvent(Event);
  3576. end else
  3577. if (Event.Buttons=mbLeftButton) and (Event.Double) then
  3578. begin
  3579. SelectWord;
  3580. ClearEvent(Event);
  3581. end else
  3582. if (Event.Buttons=mbLeftButton) and (Event.Triple) then
  3583. begin
  3584. SelectLine;
  3585. ClearEvent(Event);
  3586. end;
  3587. evKeyDown :
  3588. begin
  3589. { Scancode is almost never zero PM }
  3590. { this is supposed to enable entering of ASCII chars below 32,
  3591. which are normally interpreted as control chars. So, when you enter
  3592. Alt+24 (on the numeric pad) then this will normally move the cursor
  3593. one line down, but if you do it in ASCII mode (also after Ctrl+B)
  3594. then this will insert the ASCII #24 AnsiChar (upper arrow) in the
  3595. source code. - Gabor }
  3596. if InASCIIMode {and (Event.CharCode<>0)} then
  3597. begin
  3598. AddChar(Event.CharCode);
  3599. if (GetCompleteState<>csDenied) or (Event.CharCode=#32) then
  3600. CCAction:=ccCheck
  3601. else
  3602. CCAction:=ccClear;
  3603. end
  3604. else
  3605. begin
  3606. DontClear:=false;
  3607. case Event.KeyCode of
  3608. kbAltF10 :
  3609. Message(@Self,evCommand,cmLocalMenu,@Self);
  3610. kbEnter :
  3611. if IsReadOnly then
  3612. DontClear:=true else
  3613. if GetCompleteState=csOffering then
  3614. CodeCompleteApply
  3615. else
  3616. Message(@Self,evCommand,cmNewLine,nil);
  3617. kbEsc :
  3618. if GetCompleteState=csOffering then
  3619. CodeCompleteCancel else
  3620. if IsModal then
  3621. DontClear:=true;
  3622. else
  3623. case Event.CharCode of
  3624. #9,#32..#255 :
  3625. if (Event.CharCode=#9) and IsModal then
  3626. DontClear:=true
  3627. else
  3628. begin
  3629. NoSelect:=true;
  3630. AddChar(Event.CharCode);
  3631. NoSelect:=false;
  3632. if (GetCompleteState<>csDenied) or (Event.CharCode=#32) then
  3633. CCAction:=ccCheck
  3634. else
  3635. CCAction:=ccClear;
  3636. end;
  3637. else
  3638. DontClear:=true;
  3639. end; { case Event.CharCode .. }
  3640. end; { case Event.KeyCode .. }
  3641. if not DontClear then
  3642. ClearEvent(Event);
  3643. end;
  3644. InASCIIMode:=false;
  3645. end;
  3646. evCommand :
  3647. begin
  3648. DontClear:=false;
  3649. case Event.Command of
  3650. cmASCIIChar : InASCIIMode:=not InASCIIMode;
  3651. cmAddChar : AddChar(chr(longint(Event.InfoPtr)));
  3652. cmCharLeft : CharLeft;
  3653. cmCharRight : CharRight;
  3654. cmWordLeft : WordLeft;
  3655. cmWordRight : WordRight;
  3656. cmLineStart : LineStart;
  3657. cmLineEnd : LineEnd;
  3658. cmLineUp : LineUp;
  3659. cmLineDown : LineDown;
  3660. cmPageUp : PageUp;
  3661. cmPageDown : PageDown;
  3662. cmScrollOneUp : ScrollOneUp;
  3663. cmScrollOneDown:ScrollOneDown;
  3664. cmTextStart : TextStart;
  3665. cmTextEnd : TextEnd;
  3666. cmWindowStart : WindowStart;
  3667. cmWindowEnd : WindowEnd;
  3668. cmNewLine : begin
  3669. InsertNewLine;
  3670. TrackCursor(do_not_centre);
  3671. end;
  3672. cmBreakLine : BreakLine;
  3673. cmBackSpace : BackSpace;
  3674. cmDelChar : DelChar;
  3675. cmDelWord : DelWord;
  3676. cmDelToEndOfWord : DelToEndOfWord;
  3677. cmDelStart : DelStart;
  3678. cmDelEnd : DelEnd;
  3679. cmDelLine : DelLine;
  3680. cmInsMode : InsMode;
  3681. cmStartSelect : StartSelect;
  3682. cmHideSelect : HideSelect;
  3683. cmUpdateTitle : ;
  3684. cmEndSelect : EndSelect;
  3685. cmDelSelect : DelSelect;
  3686. cmCopyBlock : CopyBlock;
  3687. cmMoveBlock : MoveBlock;
  3688. cmIndentBlock : IndentBlock;
  3689. cmUnindentBlock : UnindentBlock;
  3690. cmSelStart : JumpSelStart;
  3691. cmSelEnd : JumpSelEnd;
  3692. cmLastCursorPos : JumpToLastCursorPos;
  3693. cmFindMatchingDelimiter : FindMatchingDelimiter(true);
  3694. cmFindMatchingDelimiterBack : FindMatchingDelimiter(false);
  3695. cmUpperCase : UpperCase;
  3696. cmLowerCase : LowerCase;
  3697. cmWordLowerCase : WordLowerCase;
  3698. cmWordUpperCase : WordUpperCase;
  3699. cmInsertOptions : InsertOptions;
  3700. cmToggleCase : ToggleCase;
  3701. cmCreateFold : CreateFoldFromBlock;
  3702. cmToggleFold : ToggleFold;
  3703. cmExpandFold : ExpandFold;
  3704. cmCollapseFold : CollapseFold;
  3705. cmJumpMark0..cmJumpMark9 : JumpMark(Event.Command-cmJumpMark0);
  3706. cmSetMark0..cmSetMark9 : DefineMark(Event.Command-cmSetMark0);
  3707. cmSelectWord : SelectWord;
  3708. cmSelectLine : SelectLine;
  3709. cmWriteBlock : WriteBlock;
  3710. cmReadBlock : ReadBlock;
  3711. cmPrintBlock : PrintBlock;
  3712. { ------ }
  3713. cmFind : Find;
  3714. cmReplace : Replace;
  3715. cmSearchAgain : DoSearchReplace;
  3716. cmJumpLine : GotoLine;
  3717. { ------ }
  3718. cmCut : ClipCut;
  3719. cmCopy : ClipCopy;
  3720. cmPaste : ClipPaste;
  3721. cmPasteText : PasteText(Event.InfoPtr,Event.Id);
  3722. cmSelectAll : SelectAll(true);
  3723. cmUnselect : SelectAll(false);
  3724. cmCommentSel : CommentSel;
  3725. cmUnCommentSel: UnCommentSel;
  3726. {$ifdef WinClipSupported}
  3727. cmCopyWin : ClipCopyWin;
  3728. cmPasteWin : ClipPasteWin;
  3729. {$endif WinClipSupported}
  3730. cmUndo : Undo;
  3731. cmRedo : Redo;
  3732. cmClear : DelSelect;
  3733. cmExpandCodeTemplate: ExpandCodeTemplate;
  3734. cmLocalMenu :
  3735. begin
  3736. P:=CurPos; Inc(P.X); Inc(P.Y);
  3737. LocalMenu(P);
  3738. end;
  3739. cmActivateMenu :
  3740. Message(Application,evCommand,cmMenu,nil);
  3741. else
  3742. begin
  3743. DontClear:=true;
  3744. CCAction:=ccDontCare;
  3745. end;
  3746. end;
  3747. if DontClear=false then
  3748. ClearEvent(Event);
  3749. end;
  3750. {$ifdef TEST_PARTIAL_SYNTAX}
  3751. evIdle :
  3752. begin
  3753. CCAction:=ccDontCare;
  3754. { Complete syntax by 20 lines increment }
  3755. { could already be quite lengthy on slow systems }
  3756. if not GetSyntaxCompleted then
  3757. UpdateAttrsRange(GetLastSyntaxedLine,GetLastSyntaxedLine+20,AttrAll);
  3758. end;
  3759. {$endif TEST_PARTIAL_SYNTAX}
  3760. evBroadcast :
  3761. begin
  3762. CCAction:=ccDontCare;
  3763. case Event.Command of
  3764. cmUpdate :
  3765. Update;
  3766. cmClearLineHighlights :
  3767. SetLineFlagExclusive(lfHighlightRow,-1);
  3768. cmResetDebuggerRow :
  3769. SetLineFlagExclusive(lfDebuggerRow,-1);
  3770. cmScrollBarChanged:
  3771. if (Event.InfoPtr = HScrollBar) or
  3772. (Event.InfoPtr = VScrollBar) then
  3773. begin
  3774. CheckScrollBar(HScrollBar, Delta.X);
  3775. CheckScrollBar(VScrollBar, Delta.Y);
  3776. end;
  3777. end;
  3778. end;
  3779. else CCAction:=ccDontCare;
  3780. end;
  3781. inherited HandleEvent(Event);
  3782. CurEvent:=OldEvent;
  3783. case CCAction of
  3784. ccCheck : CodeCompleteCheck;
  3785. ccClear : ClearCodeCompleteWord;
  3786. end;
  3787. end;
  3788. procedure TCustomCodeEditor.UpdateUndoRedo(cm : word; action : byte);
  3789. var UndoMenu : PMenuItem;
  3790. begin
  3791. UndoMenu:=PAdvancedMenuBar(MenuBar)^.GetMenuItem(cm);
  3792. if assigned(UndoMenu) then
  3793. begin
  3794. If assigned(UndoMenu^.Param) then
  3795. DisposeStr(UndoMenu^.Param);
  3796. if action<lastaction then
  3797. UndoMenu^.Param:=NewStr(ActionString[action]);
  3798. end;
  3799. end;
  3800. procedure TCustomCodeEditor.Update;
  3801. begin
  3802. Lock;
  3803. LimitsChanged;
  3804. SelectionChanged;
  3805. HighlightChanged;
  3806. UnLock;
  3807. end;
  3808. function TCustomCodeEditor.GetLocalMenu: PMenu;
  3809. begin
  3810. GetLocalMenu:=nil;
  3811. end;
  3812. function TCustomCodeEditor.GetCommandTarget: PView;
  3813. begin
  3814. GetCommandTarget:=@Self;
  3815. end;
  3816. function TCustomCodeEditor.CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup;
  3817. var MV: PMenuPopup;
  3818. begin
  3819. New(MV, Init(Bounds, M));
  3820. CreateLocalMenuView:=MV;
  3821. end;
  3822. procedure TCustomCodeEditor.LocalMenu(P: TPoint);
  3823. var M: PMenu;
  3824. MV: PMenuPopUp;
  3825. R: TRect;
  3826. Re: word;
  3827. begin
  3828. M:=GetLocalMenu;
  3829. if M=nil then Exit;
  3830. if LastLocalCmd<>0 then
  3831. M^.Default:=SearchMenuItem(M,LastLocalCmd);
  3832. Desktop^.GetExtent(R);
  3833. MakeGlobal(P,R.A); {Desktop^.MakeLocal(R.A,R.A);}
  3834. MV:=CreateLocalMenuView(R,M);
  3835. Re:=Application^.ExecView(MV);
  3836. if M^.Default=nil then LastLocalCmd:=0
  3837. else LastLocalCmd:=M^.Default^.Command;
  3838. Dispose(MV, Done);
  3839. if Re<>0 then
  3840. Message(GetCommandTarget,evCommand,Re,@Self);
  3841. end;
  3842. function TCustomCodeEditor.GetReservedColCount: sw_integer;
  3843. var LSX: sw_integer;
  3844. begin
  3845. if IsFlagSet(efFolds) then LSX:=GetFoldStringWidth else LSX:=0;
  3846. GetReservedColCount:=LSX;
  3847. end;
  3848. procedure TCustomCodeEditor.Draw;
  3849. function GetEIFold(EI: PEditorLineInfo): PFold;
  3850. begin
  3851. if Assigned(EI) then GetEIFold:=EI^.Fold else GetEIFold:=nil;
  3852. end;
  3853. var SelectColor,
  3854. HighlightColColor,
  3855. HighlightRowColor,
  3856. ErrorMessageColor : word;
  3857. B: TDrawBuffer;
  3858. X,Y,AX,AY,MaxX,LSX: sw_integer;
  3859. PX: TPoint;
  3860. LineCount: sw_integer;
  3861. Line: PCustomLine;
  3862. LineText,Format: sw_astring;
  3863. isBreak : boolean;
  3864. C: AnsiChar;
  3865. FreeFormat: array[0..MaxLineLength] of boolean;
  3866. Color: word;
  3867. ColorTab: array[coFirstColor..coLastColor] of word;
  3868. ErrorLine: integer;
  3869. {$if MaxViewWidth < 256}
  3870. ErrorMsg: string[MaxViewWidth];
  3871. {$else}
  3872. ErrorMsg: string[255];
  3873. {$endif}
  3874. function CombineColors(Orig,Modifier: byte): byte;
  3875. var Color: byte;
  3876. begin
  3877. if (Modifier and $0f)=0 then
  3878. Color:=(Orig and $0f) or (Modifier and $f0)
  3879. else
  3880. Color:=(Orig and $f0) or (Modifier and $0f);
  3881. { do not allow invisible }
  3882. { use white as foreground in this case }
  3883. if (Color and $f) = ((Color div $10) and $7) then
  3884. Color:=(Color and $F0) or $F;
  3885. CombineColors:=Color;
  3886. end;
  3887. var ShowIndent:boolean;
  3888. FoldPrefix,FoldSuffix: string;
  3889. { SkipLine: boolean;}
  3890. { FoldStartLine: sw_integer;}
  3891. begin
  3892. if ELockFlag>0 then
  3893. begin
  3894. DrawCalled:=true;
  3895. Exit;
  3896. end;
  3897. DrawCalled:=false;
  3898. ErrorMsg:=copy(GetErrorMessage,1,MaxViewWidth);
  3899. if ErrorMsg='' then ErrorLine:=-1 else
  3900. if (CurPos.Y-Delta.Y)<(Size.Y div 2) then ErrorLine:=Size.Y-1
  3901. else ErrorLine:=0;
  3902. LineCount:=GetLineCount;
  3903. ColorTab[coTextColor]:=GetColor(1);
  3904. ColorTab[coWhiteSpaceColor]:=GetColor(2);
  3905. ColorTab[coCommentColor]:=GetColor(3);
  3906. ColorTab[coReservedWordColor]:=GetColor(4);
  3907. ColorTab[coIdentifierColor]:=GetColor(5);
  3908. ColorTab[coStringColor]:=GetColor(6);
  3909. ColorTab[coNumberColor]:=GetColor(7);
  3910. ColorTab[coAssemblerColor]:=GetColor(8);
  3911. ColorTab[coSymbolColor]:=GetColor(9);
  3912. ColorTab[coDirectiveColor]:=GetColor(13);
  3913. ColorTab[coHexNumberColor]:=GetColor(14);
  3914. ColorTab[coTabColor]:=GetColor(15);
  3915. { break same as error }
  3916. ColorTab[coBreakColor]:=GetColor(16);
  3917. ColorTab[coAsmReservedColor]:=GetColor(17);
  3918. SelectColor:=GetColor(10);
  3919. HighlightColColor:=GetColor(11);
  3920. HighlightRowColor:=GetColor(12);
  3921. ErrorMessageColor:=GetColor(16);
  3922. ShowIndent:=IsFlagSet(efShowIndent) and IsFlagSet(efSyntaxHighlight);
  3923. {$ifdef TEST_PARTIAL_SYNTAX}
  3924. If (not GetSyntaxCompleted) and (GetLastSyntaxedLine<Delta.Y+Size.Y) then
  3925. UpdateAttrsRange(GetLastSyntaxedLine,Delta.Y+Size.Y,AttrAll);
  3926. {$endif TEST_PARTIAL_SYNTAX}
  3927. LSX:=GetReservedColCount;
  3928. Y:=0; AY:=Delta.Y;
  3929. for Y:=0 to Size.Y-1 do
  3930. begin
  3931. if Y=ErrorLine then
  3932. begin
  3933. MoveChar(B,' ',ErrorMessageColor,Size.X);
  3934. MoveStr(B,ErrorMsg,ErrorMessageColor);
  3935. WriteLine(0,Y,Size.X,1,B);
  3936. end
  3937. else
  3938. begin
  3939. AY:=ViewToEditorLine(Delta.Y+Y);
  3940. if (0<=AY) and (AY<LineCount) then
  3941. begin
  3942. Line:=GetLine(AY);
  3943. if assigned(Line) then
  3944. begin
  3945. IsBreak:=Line^.IsFlagSet(lfBreakpoint);
  3946. end
  3947. else
  3948. begin
  3949. IsBreak:=false;
  3950. end;
  3951. end
  3952. else
  3953. begin
  3954. Line:=nil;
  3955. IsBreak:=false;
  3956. end;
  3957. begin
  3958. Color:=ColorTab[coTextColor];
  3959. FillChar(FreeFormat,SizeOf(FreeFormat),1);
  3960. { MoveChar(B,' ',Color,Size.X); redundant, following for loop covers it all }
  3961. GetDisplayTextFormat(AY,LineText,Format);
  3962. if ShowIndent and (length(Format)=length(LineText)) then
  3963. for X:=1 to length(LineText) do
  3964. begin
  3965. if LineText[X] <> ' ' then break;
  3966. if (X>1 ) and (X and 1 = 1) then
  3967. if ord(Format[X]) in [coWhiteSpaceColor,coTabColor] then
  3968. LineText[X]:=#179; { | show line indent }
  3969. end;
  3970. MaxX:=Min(Delta.X+1+Size.X,MaxLineLength);
  3971. for X:=(MaxX-Size.X) to MaxX+1 do
  3972. begin
  3973. AX:=Delta.X+X-1;
  3974. if X<=length(LineText) then C:=LineText[X] else C:=' ';
  3975. PX.X:=AX-Delta.X; PX.Y:=AY;
  3976. if (Highlight.A.X<>Highlight.B.X) or (Highlight.A.Y<>Highlight.B.Y) then
  3977. { there's a highlight }
  3978. begin
  3979. if (PointOfs(Highlight.A)<=PointOfs(PX)) and (PointOfs(PX)<PointOfs(Highlight.B)) then
  3980. begin
  3981. Color:=SelectColor;
  3982. FreeFormat[X]:=false;
  3983. end;
  3984. end
  3985. else
  3986. { no highlight }
  3987. begin
  3988. if IsFlagSet(efVerticalBlocks) then
  3989. begin
  3990. if (SelStart.X<=AX) and (AX<=SelEnd.X) and
  3991. (SelStart.Y<=AY) and (AY<=SelEnd.Y) then
  3992. begin
  3993. Color:=SelectColor; FreeFormat[X]:=false;
  3994. end;
  3995. end
  3996. else
  3997. if PointOfs(SelStart)<>PointOfs(SelEnd) then
  3998. if (PointOfs(SelStart)<=PointOfs(PX)) and (PointOfs(PX)<PointOfs(SelEnd)) then
  3999. begin
  4000. Color:=SelectColor; FreeFormat[X]:=false;
  4001. end;
  4002. end; { no highlight }
  4003. if FreeFormat[X] then
  4004. if X<=length(Format) then
  4005. {Color:=ColorTab[ord(Format[X])] else Color:=ColorTab[coTextColor];
  4006. this give BoundsCheckError with -Cr quite often PM }
  4007. Color:=ColorTab[ord(Format[X]) mod (coLastColor + 1)] else Color:=ColorTab[coTextColor];
  4008. if IsFlagSet(efHighlightRow) and
  4009. (PX.Y=CurPos.Y) then
  4010. begin
  4011. Color:=CombineColors(Color,HighlightRowColor);
  4012. FreeFormat[X]:=false;
  4013. end;
  4014. if IsFlagSet(efHighlightColumn) and (PX.X=CurPos.X) then
  4015. begin
  4016. Color:=CombineColors(Color,HighlightColColor);
  4017. FreeFormat[X]:=false;
  4018. end;
  4019. if Assigned(Line) and Line^.IsFlagSet(lfHighlightRow) then
  4020. begin
  4021. Color:=CombineColors(Color,HighlightRowColor);
  4022. FreeFormat[X]:=false;
  4023. end;
  4024. if isbreak then
  4025. begin
  4026. Color:=ColorTab[coBreakColor];
  4027. FreeFormat[X]:=false;
  4028. end;
  4029. if Assigned(Line) and Line^.isFlagSet(lfDebuggerRow) then
  4030. begin
  4031. Color:=CombineColors(Color,HighlightRowColor);
  4032. FreeFormat[X]:=false;
  4033. end;
  4034. { redundant check, for loop condition is taking care of coorect range
  4035. if (0<=LSX+X-1-Delta.X) and (LSX+X-1-Delta.X<MaxViewWidth) then }
  4036. MoveChar(B[LSX+X-1-Delta.X],C,Color,1);
  4037. end; { for X:=1 to ... }
  4038. if IsFlagSet(efFolds) then
  4039. begin
  4040. GetFoldStrings(AY,FoldPrefix,FoldSuffix);
  4041. MoveStr(B[0],FoldPrefix,ColorTab[coTextColor]);
  4042. if FoldSuffix<>'' then
  4043. MoveStr(B[Size.X-1-length(FoldSuffix)],FoldSuffix,ColorTab[coTextColor]);
  4044. end;
  4045. WriteLine(0,Y,Size.X,1,B);
  4046. end; { if not SkipLine ... }
  4047. end; { not errorline }
  4048. end; { while (Y<Size.Y) ... }
  4049. DrawCursor;
  4050. end;
  4051. procedure TCustomCodeEditor.DrawCursor;
  4052. var InsertMode : boolean;
  4053. begin
  4054. if Elockflag>0 then
  4055. DrawCursorCalled:=true
  4056. else
  4057. begin
  4058. SetCursor(GetReservedColCount+CurPos.X-Delta.X,EditorToViewLine(CurPos.Y)-Delta.Y);
  4059. InsertMode:=Overwrite;
  4060. if IsFlagSet (efBlockInsCursor) then
  4061. InsertMode:=not InsertMode; {revers insert and overwrite mode cursor shapes}
  4062. SetState(sfCursorIns,InsertMode);
  4063. end;
  4064. end;
  4065. procedure TCustomCodeEditor.ResetCursor;
  4066. begin
  4067. if Elockflag>0 then
  4068. begin
  4069. DrawCursorCalled:=true;
  4070. exit;
  4071. end
  4072. else
  4073. inherited ResetCursor;
  4074. end;
  4075. function TCustomCodeEditor.Overwrite: boolean;
  4076. begin
  4077. Overwrite:=not IsFlagSet(efInsertMode);
  4078. end;
  4079. procedure TCustomCodeEditor.SetCodeCompleteWord(const S: string);
  4080. begin
  4081. if S<>'' then
  4082. SetCompleteState(csOffering)
  4083. else
  4084. SetCompleteState(csInactive);
  4085. end;
  4086. procedure TCustomCodeEditor.ClearCodeCompleteWord;
  4087. begin
  4088. SetCodeCompleteWord('');
  4089. SetCompleteState(csInactive);
  4090. end;
  4091. function TCustomCodeEditor.GetCompleteState: TCompleteState;
  4092. begin
  4093. { Abstract }
  4094. GetCompleteState:=csInactive;
  4095. end;
  4096. procedure TCustomCodeEditor.SetCompleteState(AState: TCompleteState);
  4097. begin
  4098. { Abstract }
  4099. end;
  4100. function TCustomCodeEditor.UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer;
  4101. begin
  4102. Abstract;
  4103. UpdateAttrs:=-1;
  4104. end;
  4105. function TCustomCodeEditor.UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer;
  4106. begin
  4107. Abstract;
  4108. UpdateAttrsRange:=-1;
  4109. end;
  4110. procedure TCustomCodeEditor.AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: sw_astring;AFlags : longint);
  4111. begin
  4112. { Abstract }
  4113. end;
  4114. procedure TCustomCodeEditor.AddGroupedAction(AAction : byte);
  4115. begin
  4116. { Abstract }
  4117. end;
  4118. procedure TCustomCodeEditor.CloseGroupedAction(AAction : byte);
  4119. begin
  4120. { Abstract }
  4121. end;
  4122. function TCustomCodeEditor.GetUndoActionCount: sw_integer;
  4123. begin
  4124. { Abstract }
  4125. GetUndoActionCount:=0;
  4126. end;
  4127. function TCustomCodeEditor.GetRedoActionCount: sw_integer;
  4128. begin
  4129. { Abstract }
  4130. GetRedoActionCount:=0;
  4131. end;
  4132. function TCustomCodeEditor.GetMaxFoldLevel: sw_integer;
  4133. var Max,L,I: sw_integer;
  4134. begin
  4135. Max:=0;
  4136. for I:=0 to GetFoldCount-1 do
  4137. begin
  4138. L:=GetFold(I)^.GetLevel;
  4139. if L>Max then Max:=L;
  4140. end;
  4141. GetMaxFoldLevel:=Max;
  4142. end;
  4143. function TCustomCodeEditor.GetFoldStringWidth: sw_integer;
  4144. begin
  4145. GetFoldStringWidth:=GetMaxFoldLevel;
  4146. end;
  4147. procedure TCustomCodeEditor.GetFoldStrings(EditorLine: sw_integer; var Prefix, Suffix: openstring);
  4148. var F: PFold;
  4149. C: AnsiChar;
  4150. begin
  4151. Prefix:=CharStr(' ',GetFoldStringWidth); Suffix:='';
  4152. F:=GetLineFold(EditorLine);
  4153. if Assigned(F) then
  4154. begin
  4155. if F^.Collapsed_ then C:=#27 else C:=#26;
  4156. Prefix[1+F^.GetLevel]:=C;
  4157. if F^.Collapsed_ then
  4158. Suffix:='('+IntToStr(F^.GetLineCount)+')';
  4159. end;
  4160. end;
  4161. function TCustomCodeEditor.GetFoldCount: sw_integer;
  4162. begin
  4163. GetFoldCount:=0;
  4164. end;
  4165. function TCustomCodeEditor.GetFold(Index: sw_integer): PFold;
  4166. begin
  4167. GetFold:=nil;
  4168. end;
  4169. procedure TCustomCodeEditor.RegisterFold(AFold: PFold);
  4170. begin
  4171. Abstract;
  4172. end;
  4173. procedure TCustomCodeEditor.UnRegisterFold(AFold: PFold);
  4174. begin
  4175. Abstract;
  4176. end;
  4177. procedure TCustomCodeEditor.Indent;
  4178. var S, PreS: sw_astring;
  4179. Shift: integer;
  4180. begin
  4181. S:=GetLineText(CurPos.Y);
  4182. if CurPos.Y>0 then
  4183. PreS:=RTrim(GetLineText(CurPos.Y-1),not IsFlagSet(efUseTabCharacters))
  4184. else
  4185. PreS:='';
  4186. if CurPos.X>=length(PreS) then
  4187. Shift:=GetTabSize
  4188. else
  4189. begin
  4190. Shift:=1;
  4191. while (CurPos.X+Shift<length(PreS)) and (PreS[CurPos.X+Shift]<>' ') do
  4192. Inc(Shift);
  4193. end;
  4194. SetLineText(CurPos.Y,RExpand(copy(S,1,CurPos.X+1),CurPos.X+1)+CharStr(' ',Shift)+copy(S,CurPos.X+2,Length(S)));
  4195. SetCurPtr(CurPos.X+Shift,CurPos.Y);
  4196. UpdateAttrs(CurPos.Y,attrAll);
  4197. DrawLines(CurPos.Y);
  4198. SetModified(true);
  4199. end;
  4200. procedure TCustomCodeEditor.CharLeft;
  4201. begin
  4202. if CurPos.X=0 then Exit;
  4203. SetCurPtr(CurPos.X-1,CurPos.Y);
  4204. end;
  4205. procedure TCustomCodeEditor.CharRight;
  4206. begin
  4207. if CurPos.X>=MaxLineLength then
  4208. Exit;
  4209. SetCurPtr(CurPos.X+1,CurPos.Y);
  4210. end;
  4211. procedure TCustomCodeEditor.WordLeft;
  4212. var X, Y: sw_integer;
  4213. Line: sw_astring;
  4214. GotIt,FoundNonSeparator: boolean;
  4215. begin
  4216. X:=CurPos.X;
  4217. Y:=CurPos.Y;
  4218. GotIt:=false;
  4219. FoundNonSeparator:=false;
  4220. while (Y>=0) do
  4221. begin
  4222. if Y=CurPos.Y then
  4223. begin
  4224. X:=length(GetDisplayText(Y));
  4225. if CurPos.X<X then
  4226. X:=CurPos.X; Dec(X);
  4227. if (X=-1) then
  4228. begin
  4229. Dec(Y);
  4230. if Y>=0 then
  4231. X:=length(GetDisplayText(Y));
  4232. Break;
  4233. end;
  4234. end
  4235. else
  4236. X:=length(GetDisplayText(Y))-1;
  4237. Line:=GetDisplayText(Y);
  4238. while (X>=0) and (GotIt=false) do
  4239. begin
  4240. if FoundNonSeparator then
  4241. begin
  4242. if IsWordSeparator(Line[X+1]) then
  4243. begin
  4244. Inc(X);
  4245. GotIt:=true;
  4246. Break;
  4247. end;
  4248. end
  4249. else
  4250. if not IsWordSeparator(Line[X+1]) then
  4251. FoundNonSeparator:=true;
  4252. Dec(X);
  4253. if (X=0) and (IsWordSeparator(Line[1])=false) then
  4254. begin
  4255. GotIt:=true;
  4256. Break;
  4257. end;
  4258. end;
  4259. if GotIt then
  4260. Break;
  4261. X:=0;
  4262. Dec(Y);
  4263. if Y>=0 then
  4264. begin
  4265. X:=length(GetDisplayText(Y));
  4266. Break;
  4267. end;
  4268. end;
  4269. if Y<0 then Y:=0; if X<0 then X:=0;
  4270. SetCurPtr(X,Y);
  4271. end;
  4272. procedure TCustomCodeEditor.WordRight;
  4273. var X, Y: sw_integer;
  4274. Line: sw_astring;
  4275. GotIt: boolean;
  4276. begin
  4277. X:=CurPos.X; Y:=CurPos.Y; GotIt:=false;
  4278. while (Y<GetLineCount) do
  4279. begin
  4280. if Y=CurPos.Y then
  4281. begin
  4282. X:=CurPos.X; Inc(X);
  4283. if (X>length(GetDisplayText(Y))-1) then
  4284. begin Inc(Y); X:=0; end;
  4285. end else X:=0;
  4286. Line:=GetDisplayText(Y);
  4287. while (X<=length(Line)+1) and (GotIt=false) and (Line<>'') do
  4288. begin
  4289. if X=length(Line)+1 then begin GotIt:=true; Dec(X); Break end;
  4290. if IsWordSeparator(Line[X]) then
  4291. begin
  4292. while (Y<GetLineCount) and
  4293. (X<=length(Line)) and (IsWordSeparator(Line[X])) do
  4294. begin
  4295. Inc(X);
  4296. if X>=length(Line) then
  4297. begin GotIt:=true; Dec(X); Break; end;
  4298. end;
  4299. if (GotIt=false) and (X<length(Line)) then
  4300. begin
  4301. Dec(X);
  4302. GotIt:=true;
  4303. Break;
  4304. end;
  4305. end;
  4306. Inc(X);
  4307. end;
  4308. if GotIt then Break;
  4309. X:=0;
  4310. Inc(Y);
  4311. if (Y<GetLineCount) then
  4312. begin
  4313. Line:=GetDisplayText(Y);
  4314. if (Line<>'') and (IsWordSeparator(Line[1])=false) then Break;
  4315. end;
  4316. end;
  4317. if Y=GetLineCount then Y:=GetLineCount-1;
  4318. SetCurPtr(X,Y);
  4319. end;
  4320. procedure TCustomCodeEditor.LineStart;
  4321. begin
  4322. SetCurPtr(0,CurPos.Y);
  4323. end;
  4324. procedure TCustomCodeEditor.LineEnd;
  4325. var
  4326. s : sw_astring;
  4327. i : longint;
  4328. begin
  4329. if CurPos.Y<GetLineCount then
  4330. begin
  4331. s:=GetDisplayText(CurPos.Y);
  4332. i:=length(s);
  4333. while (i>0) and (s[i]=' ') do
  4334. dec(i);
  4335. i:=Min(i,MaxLineLength);
  4336. SetCurPtr(i,CurPos.Y);
  4337. end
  4338. else
  4339. SetCurPtr(0,CurPos.Y);
  4340. end;
  4341. function TCustomCodeEditor.NextVisibleLine(StartLine: sw_integer; Down: boolean): sw_integer;
  4342. var Count,NL: sw_integer;
  4343. begin
  4344. if Down then
  4345. begin
  4346. Count:=GetLineCount;
  4347. NL:=StartLine;
  4348. while (NL<Count-1) and not IsLineVisible(NL) do
  4349. Inc(NL);
  4350. if NL>=Count then
  4351. NL:=-1;
  4352. end
  4353. else
  4354. begin
  4355. NL:=StartLine;
  4356. while (NL>0) and not IsLineVisible(NL) do
  4357. Dec(NL);
  4358. end;
  4359. if not IsLineVisible(NL) then
  4360. NL:=-1;
  4361. NextVisibleLine:=NL;
  4362. end;
  4363. procedure TCustomCodeEditor.LineUp;
  4364. var NL: sw_integer;
  4365. begin
  4366. NL:=NextVisibleLine(CurPos.Y-1,false);
  4367. if NL<>-1 then
  4368. SetCurPtr(CurPos.X,NL);
  4369. end;
  4370. procedure TCustomCodeEditor.LineDown;
  4371. var NL: sw_integer;
  4372. begin
  4373. NL:=NextVisibleLine(CurPos.Y+1,true);
  4374. if NL<>-1 then
  4375. SetCurPtr(CurPos.X,NL);
  4376. end;
  4377. procedure TCustomCodeEditor.PageUp;
  4378. var NL: sw_integer;
  4379. begin
  4380. ScrollTo(Delta.X,Max(Delta.Y-Size.Y,0));
  4381. NL:=Max(CurPos.Y-(Size.Y),0);
  4382. if not IsLineVisible(NL) then
  4383. NL:=NextVisibleLine(NL,false);
  4384. if NL>=0 then
  4385. SetCurPtr(CurPos.X,Max(0,NL));
  4386. end;
  4387. procedure TCustomCodeEditor.PageDown;
  4388. var NL: sw_integer;
  4389. begin
  4390. ScrollTo(Delta.X,Min(Delta.Y+Size.Y,GetLineCount-1));
  4391. NL:=Min(CurPos.Y+(Size.Y{-1}),GetLineCount-1);
  4392. if not IsLineVisible(NL) then
  4393. NL:=NextVisibleLine(NL,true);
  4394. if NL>=0 then
  4395. SetCurPtr(CurPos.X,Min(GetLineCount-1,NL));
  4396. end;
  4397. procedure TCustomCodeEditor.ScrollOneUp;
  4398. var NL: sw_integer;
  4399. LinesScroll : sw_integer;
  4400. cursorInVisibleArea : boolean;
  4401. begin
  4402. LinesScroll:=-1;
  4403. cursorInVisibleArea:= (CurPos.Y>=Delta.Y) and (CurPos.Y<(Delta.Y+Size.Y)); {ignore folds here}
  4404. NL:=NextVisibleLine(CurPos.Y-1,false);
  4405. ScrollTo(Delta.X, Delta.Y + LinesScroll);
  4406. if cursorInVisibleArea and (CurPos.Y>=(Delta.Y+Size.Y)) then {do not allow corsor leave visible area}
  4407. if NL<>-1 then
  4408. SetCurPtr(CurPos.X,NL); {cursor stick to window bottom line}
  4409. end;
  4410. procedure TCustomCodeEditor.ScrollOneDown;
  4411. var NL: sw_integer;
  4412. LinesScroll : sw_integer;
  4413. cursorInVisibleArea : boolean;
  4414. begin
  4415. LinesScroll:=1;
  4416. cursorInVisibleArea:= (CurPos.Y>=Delta.Y) and (CurPos.Y<(Delta.Y+Size.Y)); {ignore folds here}
  4417. NL:=NextVisibleLine(CurPos.Y+1,true);
  4418. ScrollTo(Delta.X, Delta.Y + LinesScroll);
  4419. if cursorInVisibleArea and (CurPos.Y<Delta.Y) then {do not allow corsor leave visible area}
  4420. if NL>=0 then
  4421. SetCurPtr(CurPos.X,Min(GetLineCount-1,NL)); {cursor stick to window top line}
  4422. end;
  4423. procedure TCustomCodeEditor.TextStart;
  4424. begin
  4425. SetCurPtr(0,0);
  4426. end;
  4427. procedure TCustomCodeEditor.TextEnd;
  4428. var s : sw_astring;
  4429. i : longint;
  4430. begin
  4431. s:=GetDisplayText(GetLineCount-1);
  4432. i:=length(s);
  4433. while (i>0) and (s[i]=' ') do
  4434. dec(i);
  4435. i:=Min(i,MaxLineLength);
  4436. SetCurPtr(i,GetLineCount-1);
  4437. end;
  4438. procedure TCustomCodeEditor.WindowStart;
  4439. begin
  4440. if not NoSelect and ShouldExtend then
  4441. TextStart {select to start}
  4442. else
  4443. SetCurPtr(CurPos.X,Delta.Y);
  4444. end;
  4445. procedure TCustomCodeEditor.WindowEnd;
  4446. begin
  4447. if not NoSelect and ShouldExtend then
  4448. TextEnd {select to end}
  4449. else
  4450. SetCurPtr(CurPos.X,Delta.Y+Size.Y-1);
  4451. end;
  4452. procedure TCustomCodeEditor.JumpSelStart;
  4453. begin
  4454. if ValidBlock then
  4455. SetCurPtr(SelStart.X,SelStart.Y);
  4456. end;
  4457. procedure TCustomCodeEditor.JumpSelEnd;
  4458. begin
  4459. if ValidBlock then
  4460. SetCurPtr(SelEnd.X,SelEnd.Y);
  4461. end;
  4462. function TCustomCodeEditor.GetBookmark(MarkIdx: sw_integer):TEditorBookMark;
  4463. var LineNr : sw_integer;
  4464. begin
  4465. GetBookmark.Valid:=false;
  4466. if not (MarkIdx in [0..9]) then exit;
  4467. with Bookmarks[MarkIdx] do
  4468. if Valid=true then
  4469. begin
  4470. LineNr:=FindMarkLineNr(MarkIdx);
  4471. if LineNr>=0 then
  4472. Pos.Y:=LineNr
  4473. else
  4474. Valid:=false;
  4475. end;
  4476. GetBookmark:=Bookmarks[MarkIdx];
  4477. end;
  4478. procedure TCustomCodeEditor.SetBookmark(MarkIdx: sw_integer; ABookmark: TEditorBookMark);
  4479. var Line : PCustomLine;
  4480. begin
  4481. if not (MarkIdx in [0..9]) then exit;
  4482. Bookmarks[MarkIdx]:=ABookmark;
  4483. if ABookmark.Valid then
  4484. begin
  4485. {invalid Pos.Y will lead to crash check it beforehand }
  4486. if (ABookmark.Pos.X<0) or (ABookmark.Pos.X>MaxLineLength)
  4487. or (ABookmark.Pos.Y<0) or (ABookmark.Pos.Y>=GetLineCount) then
  4488. begin
  4489. Bookmarks[MarkIdx].Valid:=false;
  4490. exit;
  4491. end;
  4492. Line:=GetLine(ABookmark.Pos.Y);
  4493. if Assigned(Line) then
  4494. Line^.InsertMark(@Self,@Bookmarks[MarkIdx])
  4495. else
  4496. Bookmarks[MarkIdx].Valid:=false; {this should not be ever reached, but safty first}
  4497. end;
  4498. end;
  4499. function TCustomCodeEditor.FindMarkLineNr(MarkIdx: sw_integer):sw_integer;
  4500. var Count, CurLineNr, CurMarkNr : sw_integer;
  4501. Line : PCustomLine;
  4502. LI : PEditorLineInfo;
  4503. begin
  4504. Count:=GetLineCount;
  4505. FindMarkLineNr:=-1;
  4506. if Count>1 then
  4507. for CurLineNr:=0 to Count-1 do
  4508. begin
  4509. Line:=GetLine(CurLineNr);
  4510. if Assigned(Line) then LI:=Line^.GetEditorInfo(@Self) else LI:=nil;
  4511. if Assigned(LI) then
  4512. if Assigned(LI^.BookMarks) then
  4513. begin
  4514. CurMarkNr := LI^.BookMarks^.IndexOf(@Bookmarks[MarkIdx]);
  4515. if CurMarkNr>=0 then
  4516. begin
  4517. FindMarkLineNr:=CurLineNr;
  4518. break;
  4519. end;
  4520. end;
  4521. end;
  4522. end;
  4523. procedure TCustomCodeEditor.JumpMark(MarkIdx: integer);
  4524. var LineNr : sw_integer;
  4525. begin
  4526. if (MarkIdx<Low(Bookmarks)) or (MarkIdx>High(Bookmarks)) then
  4527. begin ErrorBox(FormatStrInt(msg_invalidmarkindex,MarkIdx),nil); Exit; end;
  4528. with Bookmarks[MarkIdx] do
  4529. if Valid=false then
  4530. InformationBox(FormatStrInt(msg_marknotset,MarkIdx),nil)
  4531. else
  4532. begin
  4533. DontConsiderShiftState:=true;
  4534. LineNr:=FindMarkLineNr(MarkIdx); {Find current marked line}
  4535. if LineNr>=0 then
  4536. SetCurPtr(Pos.X,LineNr)
  4537. else
  4538. InformationBox(FormatStrInt(msg_marknotset,MarkIdx),nil);
  4539. DontConsiderShiftState:=false;
  4540. end;
  4541. end;
  4542. procedure TCustomCodeEditor.DefineMark(MarkIdx: integer);
  4543. var Line : PCustomLine;
  4544. LI : PEditorLineInfo;
  4545. LineNr : sw_integer;
  4546. begin
  4547. if (MarkIdx<Low(Bookmarks)) or (MarkIdx>High(Bookmarks)) then
  4548. begin
  4549. ErrorBox(FormatStrInt(msg_invalidmarkindex,MarkIdx),nil);
  4550. Exit;
  4551. end;
  4552. if Bookmarks[MarkIdx].Valid then
  4553. begin
  4554. LineNr:=FindMarkLineNr(MarkIdx); {find current marked line}
  4555. if LineNr>=0 then
  4556. begin
  4557. Line:=GetLine(LineNr);
  4558. Line^.DeleteMark(@Self,@Bookmarks[MarkIdx]);
  4559. end;
  4560. end;
  4561. Line:=GetLine(CurPos.Y);
  4562. Line^.InsertMark(@Self,@Bookmarks[MarkIdx]);
  4563. with Bookmarks[MarkIdx] do
  4564. begin
  4565. Pos:=CurPos;
  4566. Valid:=true;
  4567. end;
  4568. end;
  4569. procedure TCustomCodeEditor.JumpToLastCursorPos;
  4570. begin
  4571. NotImplemented;
  4572. end;
  4573. procedure TCustomCodeEditor.UpperCase;
  4574. var StartP,EndP: TPoint;
  4575. begin
  4576. if ValidBlock=false then Exit;
  4577. GetSelectionArea(StartP,EndP);
  4578. AddGroupedAction(eaUpperCase);
  4579. ChangeCaseArea(StartP,EndP,caToUpperCase);
  4580. CloseGroupedAction(eaUpperCase);
  4581. end;
  4582. procedure TCustomCodeEditor.LowerCase;
  4583. var StartP,EndP: TPoint;
  4584. begin
  4585. if ValidBlock=false then Exit;
  4586. GetSelectionArea(StartP,EndP);
  4587. AddGroupedAction(eaLowerCase);
  4588. ChangeCaseArea(StartP,EndP,caToLowerCase);
  4589. CloseGroupedAction(eaLowerCase);
  4590. end;
  4591. procedure TCustomCodeEditor.ToggleCase;
  4592. var StartP,EndP: TPoint;
  4593. begin
  4594. if ValidBlock=false then Exit;
  4595. GetSelectionArea(StartP,EndP);
  4596. AddGroupedAction(eaToggleCase);
  4597. ChangeCaseArea(StartP,EndP,caToggleCase);
  4598. CloseGroupedAction(eaToggleCase);
  4599. end;
  4600. procedure TCustomCodeEditor.WordLowerCase;
  4601. var StartP,EndP: TPoint;
  4602. begin
  4603. if GetCurrentWordArea(StartP,EndP)=false then Exit;
  4604. AddGroupedAction(eaLowerCase);
  4605. ChangeCaseArea(StartP,EndP,caToLowerCase);
  4606. CloseGroupedAction(eaLowerCase);
  4607. end;
  4608. procedure TCustomCodeEditor.WordUpperCase;
  4609. var StartP,EndP: TPoint;
  4610. begin
  4611. if GetCurrentWordArea(StartP,EndP)=false then Exit;
  4612. AddGroupedAction(eaUpperCase);
  4613. ChangeCaseArea(StartP,EndP,caToUpperCase);
  4614. CloseGroupedAction(eaUpperCase);
  4615. end;
  4616. procedure TCustomCodeEditor.CreateFoldFromBlock;
  4617. var StartY,EndY: sw_integer;
  4618. begin
  4619. if not IsFlagSet(efFolds) then Exit;
  4620. if not ValidBlock then Exit;
  4621. StartY:=SelStart.Y; EndY:=SelEnd.Y;
  4622. if SelEnd.X=0 then Dec(EndY);
  4623. if CreateFold(StartY,EndY,false)=false then
  4624. ErrorBox(msg_foldboundsarenotvalid,nil);
  4625. end;
  4626. procedure TCustomCodeEditor.ToggleFold;
  4627. var F: PFold;
  4628. begin
  4629. if not IsFlagSet(efFolds) then Exit;
  4630. F:=GetLineFold(CurPos.Y);
  4631. if Assigned(F) then
  4632. F^.Collapse(not F^.Collapsed_);
  4633. end;
  4634. procedure TCustomCodeEditor.ExpandFold;
  4635. var F: PFold;
  4636. begin
  4637. if not IsFlagSet(efFolds) then Exit;
  4638. F:=GetLineFold(CurPos.Y);
  4639. if Assigned(F) then
  4640. F^.Collapse(false);
  4641. end;
  4642. procedure TCustomCodeEditor.CollapseFold;
  4643. var F: PFold;
  4644. begin
  4645. if not IsFlagSet(efFolds) then Exit;
  4646. F:=GetLineFold(CurPos.Y);
  4647. if Assigned(F) then
  4648. F^.Collapse(true);
  4649. end;
  4650. procedure TCustomCodeEditor.ChangeCaseArea(StartP,EndP: TPoint; CaseAction: TCaseAction);
  4651. var Y,X: sw_integer;
  4652. X1,X2: sw_integer;
  4653. S: sw_astring;
  4654. C: AnsiChar;
  4655. StartPos : TPoint;
  4656. HoldUndo : boolean;
  4657. begin
  4658. Lock;
  4659. HoldUndo:=GetStoreUndo;
  4660. SetStoreUndo(false);
  4661. for Y:=StartP.Y to EndP.Y do
  4662. begin
  4663. S:=GetDisplayText(Y);
  4664. { Pierre, please implement undo here! Gabor }
  4665. X1:=0; X2:=length(S)-1;
  4666. if Y=StartP.Y then X1:=StartP.X;
  4667. if Y=EndP.Y then X2:=EndP.X;
  4668. SetStoreUndo(HoldUndo);
  4669. StartPos.X:=X1;
  4670. StartPos.Y:=Y;
  4671. { the only drawback is that we keep
  4672. the original text even if Toggle where
  4673. it is not really necessary PM }
  4674. Addaction(eaOverwriteText,StartPos,StartPos,Copy(S,X1+1,X2-X1+1),GetFlags);
  4675. SetStoreUndo(false);
  4676. for X:=X1 to X2 do
  4677. begin
  4678. C:=S[X+1];
  4679. case CaseAction of
  4680. caToLowerCase : C:=LowCase(C);
  4681. caToUpperCase : C:=UpCase(C);
  4682. caToggleCase : if C in['a'..'z'] then
  4683. C:=Upcase(C)
  4684. else
  4685. C:=LowCase(C);
  4686. end;
  4687. S[X+1]:=C;
  4688. end;
  4689. SetDisplayText(Y,S);
  4690. end;
  4691. UpdateAttrsRange(StartP.Y,EndP.Y,attrAll);
  4692. DrawLines(CurPos.Y);
  4693. SetModified(true);
  4694. Addaction(eaMoveCursor,StartPos,CurPos,'',GetFlags);
  4695. SetStoreUndo(HoldUndo);
  4696. UnLock;
  4697. end;
  4698. procedure TCustomCodeEditor.PushInfo(Const st : string);
  4699. begin
  4700. { Dummies }
  4701. end;
  4702. procedure TCustomCodeEditor.PopInfo;
  4703. begin
  4704. { Dummies }
  4705. end;
  4706. procedure TCustomCodeEditor.InsertOptions;
  4707. begin
  4708. { Abstract }
  4709. NotImplemented;
  4710. end;
  4711. function TCustomCodeEditor.GetLineFold(EditorLine: sw_integer): PFold;
  4712. var L: PCustomLine;
  4713. LI: PEditorLineInfo;
  4714. F: PFold;
  4715. begin
  4716. F:=nil;
  4717. if IsFlagSet(efFolds) then
  4718. if (0<=EditorLine) and (EditorLine<GetLineCount) then
  4719. begin
  4720. L:=GetLine(EditorLine);
  4721. if Assigned(L) then
  4722. LI:=L^.GetEditorInfo(@Self)
  4723. else
  4724. LI:=nil;
  4725. if Assigned(LI) then
  4726. F:=LI^.Fold;
  4727. end;
  4728. GetLineFold:=F;
  4729. end;
  4730. function TCustomCodeEditor.IsLineVisible(EditorLine: sw_integer): boolean;
  4731. var V: boolean;
  4732. F,PrevF: PFold;
  4733. FoldHeadline: boolean;
  4734. begin
  4735. V:=true;
  4736. if IsFlagSet(efFolds) then
  4737. begin
  4738. F:=GetLineFold(EditorLine);
  4739. if Assigned(F) then
  4740. begin
  4741. PrevF:=GetLineFold(EditorLine-1);
  4742. FoldHeadline:=false;
  4743. if (PrevF<>F) and ((PrevF=nil) or (not PrevF^.IsParent(F))) then
  4744. FoldHeadline:=true;
  4745. if FoldHeadline then
  4746. begin
  4747. if Assigned(F^.ParentFold) and (F^.ParentFold^.IsCollapsed) then
  4748. V:=false;
  4749. end
  4750. else
  4751. if F^.IsCollapsed then
  4752. V:=false;
  4753. end;
  4754. end;
  4755. IsLineVisible:=V;
  4756. end;
  4757. function TCustomCodeEditor.ViewToEditorLine(ViewLine: sw_integer): sw_integer;
  4758. var I,Line,Count: sw_integer;
  4759. begin
  4760. if not IsFlagSet(efFolds) then
  4761. Line:=ViewLine
  4762. else
  4763. begin
  4764. Count:=GetLineCount;
  4765. I:=0; Line:=-1;
  4766. while (Line<ViewLine) and (I<Count) do
  4767. begin
  4768. if IsLineVisible(I) then
  4769. Inc(Line);
  4770. Inc(I);
  4771. end;
  4772. if Line<>ViewLine then
  4773. Line:=-1
  4774. else
  4775. Line:=I-1;
  4776. end;
  4777. ViewToEditorLine:=Line;
  4778. end;
  4779. function TCustomCodeEditor.EditorToViewLine(EditorLine: sw_integer): sw_integer;
  4780. var I,Line: sw_integer;
  4781. begin
  4782. if not IsFlagSet(efFolds) then
  4783. Line:=EditorLine
  4784. else
  4785. begin
  4786. Line:=-1;
  4787. for I:=0 to EditorLine do
  4788. if IsLineVisible(I) then
  4789. Inc(Line);
  4790. end;
  4791. EditorToViewLine:=Line;
  4792. end;
  4793. procedure TCustomCodeEditor.ViewToEditorPoint(P: TPoint; var NP: TPoint);
  4794. begin
  4795. NP.X:=P.X-GetReservedColCount;
  4796. NP.Y:=ViewToEditorLine(P.Y);
  4797. end;
  4798. procedure TCustomCodeEditor.EditorToViewPoint(P: TPoint; var NP: TPoint);
  4799. begin
  4800. NP.X:=P.X+GetReservedColCount;
  4801. NP.Y:=EditorToViewLine(P.Y);
  4802. end;
  4803. procedure TCustomCodeEditor.FindMatchingDelimiter(ScanForward: boolean);
  4804. const OpenSymbols : string[6] = '[{(<''"';
  4805. CloseSymbols : string[6] = ']})>''"';
  4806. var SymIdx: integer;
  4807. LineText,LineAttr: sw_astring;
  4808. CurChar: AnsiChar;
  4809. X,Y: sw_integer;
  4810. LineCount: sw_integer;
  4811. JumpPos: TPoint;
  4812. BracketLevel: integer;
  4813. begin
  4814. JumpPos.X:=-1; JumpPos.Y:=-1;
  4815. LineText:=GetDisplayText(CurPos.Y);
  4816. LineText:=copy(LineText,CurPos.X+1,1);
  4817. if LineText='' then Exit;
  4818. CurChar:=LineText[1];
  4819. Y:=CurPos.Y; X:=CurPos.X; LineCount:=0;
  4820. BracketLevel:=1;
  4821. if ScanForward then
  4822. begin
  4823. SymIdx:=Pos(CurChar,OpenSymbols);
  4824. if SymIdx=0 then Exit;
  4825. repeat
  4826. Inc(LineCount);
  4827. GetDisplayTextFormat(Y,LineText,LineAttr);
  4828. if LineCount<>1 then X:=-1;
  4829. repeat
  4830. Inc(X);
  4831. if X<length(LineText) then
  4832. if copy(LineAttr,X+1,1)<>chr(attrComment) then
  4833. if (LineText[X+1]=CloseSymbols[SymIdx]) and (BracketLevel=1) then
  4834. begin
  4835. JumpPos.X:=X; JumpPos.Y:=Y;
  4836. end
  4837. else
  4838. if LineText[X+1]=OpenSymbols[SymIdx] then
  4839. Inc(BracketLevel)
  4840. else
  4841. if LineText[X+1]=CloseSymbols[SymIdx] then
  4842. if BracketLevel>1 then
  4843. Dec(BracketLevel);
  4844. until (X>=length(LineText)) or (JumpPos.X<>-1);
  4845. Inc(Y);
  4846. until (Y>=GetLineCount) or (JumpPos.X<>-1);
  4847. end
  4848. else
  4849. begin
  4850. SymIdx:=Pos(CurChar,CloseSymbols);
  4851. if SymIdx=0 then Exit;
  4852. repeat
  4853. Inc(LineCount);
  4854. GetDisplayTextFormat(Y,LineText,LineAttr);
  4855. if LineCount<>1 then X:=length(LineText);
  4856. repeat
  4857. Dec(X);
  4858. if X>0 then
  4859. if copy(LineAttr,X+1,1)<>chr(attrComment) then
  4860. if (LineText[X+1]=OpenSymbols[SymIdx]) and (BracketLevel=1) then
  4861. begin
  4862. JumpPos.X:=X; JumpPos.Y:=Y;
  4863. end
  4864. else
  4865. if LineText[X+1]=CloseSymbols[SymIdx] then
  4866. Inc(BracketLevel)
  4867. else
  4868. if LineText[X+1]=OpenSymbols[SymIdx] then
  4869. if BracketLevel>1 then
  4870. Dec(BracketLevel);
  4871. until (X<0) or (JumpPos.X<>-1);
  4872. Dec(Y);
  4873. until (Y<0) or (JumpPos.X<>-1);
  4874. end;
  4875. if JumpPos.X<>-1 then
  4876. begin
  4877. SetCurPtr(JumpPos.X,JumpPos.Y);
  4878. TrackCursor(do_centre);
  4879. end;
  4880. end;
  4881. function TCustomCodeEditor.InsertNewLine: Sw_integer;
  4882. var i,Ind: Sw_integer;
  4883. S,IndentStr: Sw_astring;
  4884. procedure CalcIndent(LineOver: Sw_integer);
  4885. begin
  4886. if (LineOver<0) or (LineOver>GetLineCount) or ((GetFlags and efNoIndent)<>0) then
  4887. Ind:=0 else
  4888. begin
  4889. repeat
  4890. IndentStr:=GetDisplayText(LineOver);
  4891. Dec(LineOver);
  4892. until (LineOver<0) or (IndentStr<>'');
  4893. Ind:=0;
  4894. while (Ind<length(IndentStr)) and (IndentStr[Ind+1]=' ') do
  4895. Inc(Ind);
  4896. end;
  4897. IndentStr:=CharStr(' ',Ind);
  4898. end;
  4899. var {SelBack: sw_integer;}
  4900. SCP: TPoint;
  4901. CI : sw_integer;
  4902. HoldUndo : Boolean;
  4903. L,NewL: PCustomLine;
  4904. EI,NewEI: PEditorLineInfo;
  4905. begin
  4906. if IsReadOnly then begin InsertNewLine:=-1; Exit; end;
  4907. Lock;
  4908. SCP:=CurPos;
  4909. HoldUndo:=GetStoreUndo;
  4910. SetStoreUndo(false);
  4911. if CurPos.Y<GetLineCount then S:=GetLineText(CurPos.Y) else S:='';
  4912. if Overwrite=false then
  4913. begin
  4914. if CurPos.Y<GetLineCount then
  4915. begin
  4916. L:=GetLine(CurPos.Y);
  4917. if not assigned(L) then
  4918. EI:=nil
  4919. else
  4920. EI:=L^.GetEditorInfo(@Self);
  4921. end
  4922. else
  4923. EI:=nil;
  4924. { SelBack:=0;}
  4925. CI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
  4926. if GetLineCount>0 then
  4927. begin
  4928. S:=GetLineText(CurPos.Y);
  4929. { SelBack:=length(S)-SelEnd.X;}
  4930. SetLineText(CurPos.Y,RTrim(S,not IsFlagSet(efUseTabCharacters)));
  4931. end;
  4932. CalcIndent(CurPos.Y);
  4933. SetLineText(CurPos.Y,copy(S,1,CI-1));
  4934. S:=copy(S,CI,Length(S));
  4935. i:=1;
  4936. while (i<=length(s)) and (i<=length(IndentStr)) and (s[i]=' ') do
  4937. inc(i);
  4938. if i>1 then
  4939. Delete(IndentStr,1,i-1);
  4940. NewL:=InsertLine(CurPos.Y+1,IndentStr+S);
  4941. LimitsChanged;
  4942. (* if PointOfs(SelStart)<>PointOfs(SelEnd) then { !!! check it - it's buggy !!! }
  4943. begin SelEnd.Y:=CurPos.Y+1; SelEnd.X:=length(GetLineText(CurPos.Y+1))-SelBack; end;*)
  4944. UpdateAttrs(CurPos.Y,attrAll);
  4945. AdjustBookMark(CurPos.X,Ind,CurPos.Y,CurPos.Y+1);
  4946. SetCurPtr(Ind,CurPos.Y+1);
  4947. NewEI:=NewL^.GetEditorInfo(@Self);
  4948. if Assigned(EI) and Assigned(NewEI) then
  4949. begin
  4950. NewEI^.SetFold(EI^.Fold);
  4951. if Assigned(EI^.Fold) then
  4952. if EI^.Fold^.IsCollapsed then
  4953. EI^.Fold^.Collapse(false);
  4954. end;
  4955. SetStoreUndo(HoldUndo);
  4956. { obsolete IndentStr is taken care of by the Flags PM }
  4957. Addaction(eaInsertLine,SCP,CurPos,CharStr(' ',i-1){IndentStr},GetFlags);
  4958. SetStoreUndo(false);
  4959. AdjustSelectionPos(SCP.X,SCP.Y,CurPos.X-SCP.X,CurPos.Y-SCP.Y);
  4960. end else
  4961. begin
  4962. CalcIndent(CurPos.Y);
  4963. if CurPos.Y=GetLineCount-1 then
  4964. begin
  4965. AddLine(IndentStr);
  4966. AdjustSelectionBefore(0,1);
  4967. LimitsChanged;
  4968. SetStoreUndo(HoldUndo);
  4969. UpdateAttrs(CurPos.Y,attrAll);
  4970. AdjustBookMark(CurPos.X,Ind,CurPos.Y,CurPos.Y+1);
  4971. SetCurPtr(Ind,CurPos.Y+1);
  4972. { obsolete IndentStr is taken care of by the Flags PM }
  4973. Addaction(eaInsertLine,SCP,CurPos,''{IndentStr},GetFlags);
  4974. SetStoreUndo(false);
  4975. end
  4976. else
  4977. begin
  4978. UpdateAttrs(CurPos.Y,attrAll);
  4979. SetStoreUndo(HoldUndo);
  4980. AdjustBookMark(CurPos.X,Ind,CurPos.Y,CurPos.Y+1);
  4981. SetCurPtr(Ind,CurPos.Y+1);
  4982. AddAction(eaMoveCursor,SCP,CurPos,'',GetFlags);
  4983. SetStoreUndo(false);
  4984. end;
  4985. end;
  4986. DrawLines(CurPos.Y);
  4987. SetStoreUndo(HoldUndo);
  4988. SetModified(true);
  4989. Unlock;
  4990. end;
  4991. procedure TCustomCodeEditor.BreakLine;
  4992. var
  4993. SCP: TPoint;
  4994. begin
  4995. { Like insert new line, but leave current pos unchanged }
  4996. SCP:=CurPos;
  4997. InsertNewLine;
  4998. SetCurPtr(SCP.X,SCP.Y);
  4999. end;
  5000. procedure TCustomCodeEditor.BackSpace;
  5001. var S,PreS: sw_astring;
  5002. OI,CI,CP,Y,TX: Sw_integer;
  5003. SCP,SC1 : TPoint;
  5004. HoldUndo : Boolean;
  5005. begin
  5006. if IsReadOnly then Exit;
  5007. Lock;
  5008. SCP:=CurPos;
  5009. HoldUndo:=GetStoreUndo;
  5010. SetStoreUndo(false);
  5011. if CurPos.X=0 then
  5012. begin
  5013. if CurPos.Y>0 then
  5014. begin
  5015. CI:=Length(GetDisplayText(CurPos.Y-1));
  5016. AdjustBookMark(0,CI,CurPos.Y,CurPos.Y-1);
  5017. S:=GetLineText(CurPos.Y-1);
  5018. SetLineText(CurPos.Y-1,S+GetLineText(CurPos.Y));
  5019. SC1.X:=Length(S);SC1.Y:=CurPOS.Y-1;
  5020. SetStoreUndo(HoldUndo);
  5021. AddAction(eaDeleteLine,SCP,SC1,GetLineText(CurPos.Y),GetFlags);
  5022. SetStoreUndo(false);
  5023. DeleteLine(CurPos.Y);
  5024. LimitsChanged;
  5025. SetCurPtr(CI,CurPos.Y-1);
  5026. AdjustSelectionPos(Ci,CurPos.Y,CurPos.X-SCP.X,CurPos.Y-SCP.Y);
  5027. end;
  5028. end
  5029. else
  5030. begin
  5031. CP:=CurPos.X-1;
  5032. S:=GetLineText(CurPos.Y);
  5033. CI:=LinePosToCharIdx(CurPos.Y,CP);
  5034. if (ci>0) and (ci<=length(S)) then
  5035. if (s[ci]=TAB) {and (CharIdxToLinePos(Curpos.y,ci)=cp)} then
  5036. CP:=CharIdxToLinePos(CurPos.Y,CI);
  5037. if IsFlagSet(efBackspaceUnindents) then
  5038. begin
  5039. S:=GetDisplayText(CurPos.Y);
  5040. if Trim(copy(S,1,CP+1))='' then
  5041. begin
  5042. Y:=CurPos.Y;
  5043. while (Y>0) do
  5044. begin
  5045. Dec(Y);
  5046. PreS:=GetDisplayText(Y);
  5047. if Trim(copy(PreS,1,CP+1))<>'' then Break;
  5048. end;
  5049. if Y<0 then PreS:='';
  5050. TX:=0;
  5051. while (TX<length(PreS)) and (PreS[TX+1]=' ') do
  5052. Inc(TX);
  5053. if TX<CP then CP:=TX;
  5054. end;
  5055. end;
  5056. S:=GetLineText(CurPos.Y);
  5057. OI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
  5058. CI:=LinePosToCharIdx(CurPos.Y,CP);
  5059. SetLineText(CurPos.Y,copy(S,1,CI-1)+copy(S,OI,Length(S)));
  5060. SetCurPtr(CP,CurPos.Y);
  5061. SetStoreUndo(HoldUndo);
  5062. Addaction(eaDeleteText,SCP,CurPos,Copy(S,CI,OI-CI),GetFlags);
  5063. SetStoreUndo(false);
  5064. AdjustSelectionPos(SCP.X-1,SCP.Y,CurPos.X-SCP.X,CurPos.Y-SCP.Y);
  5065. end;
  5066. UpdateAttrs(CurPos.Y,attrAll);
  5067. DrawLines(CurPos.Y);
  5068. SetStoreUndo(HoldUndo);
  5069. SetModified(true);
  5070. Unlock;
  5071. end;
  5072. procedure TCustomCodeEditor.DelChar;
  5073. var S: sw_astring;
  5074. SDX,SDY,CI : sw_integer;
  5075. HoldUndo : boolean;
  5076. SCP : TPoint;
  5077. begin
  5078. if IsReadOnly then Exit;
  5079. Lock;
  5080. HoldUndo:=GetStoreUndo;
  5081. SetStoreUndo(false);
  5082. S:=GetLineText(CurPos.Y);
  5083. CI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
  5084. if (CI>length(S)) or (S='') then
  5085. begin
  5086. if CurPos.Y<GetLineCount-1 then
  5087. begin
  5088. SetLineText(CurPos.Y,S+CharStr(' ',CurPOS.X-Length(S))+GetLineText(CurPos.Y+1));
  5089. AdjustBookMark(0,CurPos.X,CurPos.Y+1,CurPos.Y);
  5090. SDX:=CurPos.X;
  5091. SetStoreUndo(HoldUndo);
  5092. SCP.X:=0;SCP.Y:=CurPos.Y+1;
  5093. AddGroupedAction(eaDelChar);
  5094. AddAction(eaMoveCursor,CurPos,SCP,'',GetFlags);
  5095. S:=GetLineText(CurPos.Y+1);
  5096. AddAction(eaDeleteLine,SCP,CurPos,S,GetFlags);
  5097. CloseGroupedAction(eaDelChar);
  5098. SetStoreUndo(false);
  5099. DeleteLine(CurPos.Y+1);
  5100. LimitsChanged;
  5101. SDY:=-1;
  5102. SetCurPtr(CurPos.X,CurPos.Y);
  5103. UpdateAttrs(CurPos.Y,attrAll);
  5104. AdjustSelectionPos(CurPos.X,CurPos.Y,SDX,SDY);
  5105. end;
  5106. end
  5107. else
  5108. begin
  5109. SCP:=CurPos;
  5110. { Problem if S[CurPos.X+1]=TAB !! PM }
  5111. if S[CI]=TAB then
  5112. begin
  5113. { we want to remove the tab if we are at the first place
  5114. of the tab, but the following test was true for the last position
  5115. in tab
  5116. if CharIdxToLinePos(Curpos.y,ci)=Curpos.x then }
  5117. if CharIdxToLinePos(Curpos.y,ci-1)=Curpos.x-1 then
  5118. Delete(S,Ci,1)
  5119. else
  5120. S:=Copy(S,1,CI-1)+CharStr(' ',GetTabSize-1)+Copy(S,CI+1,Length(S));
  5121. SetStoreUndo(HoldUndo);
  5122. Addaction(eaDeleteText,CurPos,CurPos,#9,GetFlags);
  5123. SDX:=-1;
  5124. SetStoreUndo(false);
  5125. end
  5126. else
  5127. begin
  5128. SetStoreUndo(HoldUndo);
  5129. Addaction(eaDeleteText,CurPos,CurPos,S[CI],GetFlags);
  5130. SetStoreUndo(false);
  5131. SDX:=-1;
  5132. Delete(S,CI,1);
  5133. end;
  5134. SetLineText(CurPos.Y,S);
  5135. SDY:=0;
  5136. SetCurPtr(CurPos.X,CurPos.Y);
  5137. UpdateAttrs(CurPos.Y,attrAll);
  5138. AdjustSelectionPos(SCP.X,SCP.Y,SDX,SDY);
  5139. end;
  5140. DrawLines(CurPos.Y);
  5141. SetStoreUndo(HoldUndo);
  5142. SetModified(true);
  5143. Unlock;
  5144. end;
  5145. procedure TCustomCodeEditor.DelWord;
  5146. var
  5147. SP,EP : TPoint;
  5148. SelSize : sw_integer;
  5149. begin
  5150. if IsReadOnly then Exit;
  5151. Lock;
  5152. SP:=SelStart;
  5153. EP:=SelEnd;
  5154. SetSelection(SelStart,SelStart);
  5155. SelectWord;
  5156. SelSize:=SelEnd.X-SelStart.X;
  5157. DelSelect;
  5158. SetSelection(SP,EP);
  5159. AdjustSelectionPos(CurPos.X,CurPos.Y,-SelSize,0);
  5160. if SelSize>0 then
  5161. SetModified(true);
  5162. Unlock;
  5163. end;
  5164. procedure TCustomCodeEditor.DelToEndOfWord;
  5165. var
  5166. SP,EP : TPoint;
  5167. S : String;
  5168. SelSize : sw_integer;
  5169. begin
  5170. if IsReadOnly then Exit;
  5171. Lock;
  5172. SP:=SelStart;
  5173. EP:=SelEnd;
  5174. SetSelection(SelStart,SelStart);
  5175. SelectWord;
  5176. S:=GetDisplayText(CurPos.Y);
  5177. if ((SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y)) then
  5178. begin
  5179. if (Length(S) <= CurPos.X) then
  5180. begin
  5181. SetSelection(SP,EP);
  5182. DelChar;
  5183. Unlock;
  5184. exit;
  5185. end
  5186. else
  5187. begin
  5188. SelEnd.X:=CurPos.X+1;
  5189. SelEnd.Y:=CurPos.Y;
  5190. end;
  5191. end;
  5192. while (length(S)>= SelEnd.X+1) and
  5193. ((S[SelEnd.X+1]=' ') or (S[SelEnd.X+1]=TAB)) do
  5194. inc(SelEnd.X);
  5195. SetSelection(CurPos,SelEnd);
  5196. SelSize:=SelEnd.X-SelStart.X;
  5197. DelSelect;
  5198. SetSelection(SP,EP);
  5199. AdjustSelectionPos(CurPos.X,CurPos.Y,-SelSize,0);
  5200. if SelSize>0 then
  5201. SetModified(true);
  5202. Unlock;
  5203. end;
  5204. procedure TCustomCodeEditor.DelStart;
  5205. var S: sw_astring;
  5206. OI: Sw_integer;
  5207. HoldUndo : Boolean;
  5208. SCP : TPoint;
  5209. begin
  5210. if IsReadOnly then Exit;
  5211. Lock;
  5212. HoldUndo:=GetStoreUndo;
  5213. SetStoreUndo(false);
  5214. SCP:=CurPos;
  5215. S:=GetLineText(CurPos.Y);
  5216. if (S<>'') and (CurPos.X<>0) then
  5217. begin
  5218. OI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
  5219. SetLineText(CurPos.Y,copy(S,OI,Length(S)));
  5220. SetCurPtr(0,CurPos.Y);
  5221. SetStoreUndo(HoldUndo);
  5222. Addaction(eaDeleteText,SCP,CurPos,copy(S,1,OI-1),GetFlags);
  5223. SetStoreUndo(false);
  5224. AdjustSelectionPos(CurPos.X,CurPos.Y,-length(copy(S,1,OI-1)),0);
  5225. UpdateAttrs(CurPos.Y,attrAll);
  5226. DrawLines(CurPos.Y);
  5227. SetModified(true);
  5228. end;
  5229. SetStoreUndo(HoldUndo);
  5230. Unlock;
  5231. end;
  5232. procedure TCustomCodeEditor.DelEnd;
  5233. var S: sw_astring;
  5234. OI: Sw_integer;
  5235. HoldUndo : Boolean;
  5236. SCP : TPoint;
  5237. begin
  5238. if IsReadOnly then Exit;
  5239. Lock;
  5240. HoldUndo:=GetStoreUndo;
  5241. SetStoreUndo(false);
  5242. SCP:=CurPos;
  5243. S:=GetLineText(CurPos.Y);
  5244. if (S<>'') and (CurPos.X<>length(S)) then
  5245. begin
  5246. OI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
  5247. SetLineText(CurPos.Y,copy(S,1,OI-1));
  5248. SetCurPtr(CurPos.X,CurPos.Y);
  5249. SetStoreUndo(HoldUndo);
  5250. Addaction(eaDeleteText,SCP,CurPos,copy(S,OI,Length(S)),GetFlags);
  5251. SetStoreUndo(false);
  5252. AdjustSelectionPos(CurPos.X+1,CurPos.Y,-length(copy(S,OI,Length(S)))+1,0);
  5253. UpdateAttrs(CurPos.Y,attrAll);
  5254. DrawLines(CurPos.Y);
  5255. SetModified(true);
  5256. end;
  5257. SetStoreUndo(HoldUndo);
  5258. Unlock;
  5259. end;
  5260. procedure TCustomCodeEditor.DelLine;
  5261. var
  5262. HoldUndo : boolean;
  5263. SP : TPoint;
  5264. S : Sw_AString;
  5265. begin
  5266. if IsReadOnly then Exit;
  5267. Lock;
  5268. if GetLineCount>0 then
  5269. begin
  5270. SP:=CurPos;
  5271. S:=GetLineText(CurPos.Y);
  5272. HoldUndo:=GetStoreUndo;
  5273. SetStoreUndo(false);
  5274. DeleteLine(CurPos.Y);
  5275. LimitsChanged;
  5276. AdjustSelectionBefore(0,-1);
  5277. SetCurPtr(0,CurPos.Y);
  5278. UpdateAttrs(Max(0,CurPos.Y-1),attrAll);
  5279. DrawLines(CurPos.Y);
  5280. SetStoreUndo(HoldUndo);
  5281. AddAction(eaDeleteLine,SP,CurPos,S,GetFlags);
  5282. SetModified(true);
  5283. end;
  5284. Unlock;
  5285. end;
  5286. procedure TCustomCodeEditor.InsMode;
  5287. begin
  5288. SetInsertMode(Overwrite);
  5289. end;
  5290. function TCustomCodeEditor.GetCurrentWordArea(var StartP,EndP: TPoint): boolean;
  5291. const WordChars = ['A'..'Z','a'..'z','0'..'9','_'];
  5292. var P : TPoint;
  5293. S : Sw_AString;
  5294. StartPos,EndPos : sw_integer;
  5295. OK: boolean;
  5296. begin
  5297. P:=CurPos;
  5298. S:=GetLineText(P.Y);
  5299. StartPos:=P.X+1;
  5300. EndPos:=StartPos;
  5301. Ok:=false;
  5302. if Length(S)>=StartPos then
  5303. OK:=(S[StartPos] in WordChars);
  5304. if OK then
  5305. begin
  5306. While (StartPos>1) and (S[StartPos-1] in WordChars) do
  5307. Dec(StartPos);
  5308. While (EndPos<Length(S)) and (S[EndPos+1] in WordChars) do
  5309. Inc(EndPos);
  5310. StartP.X:=StartPos-1; StartP.Y:=CurPos.Y;
  5311. EndP.X:=EndPos-1; EndP.Y:=CurPos.Y;
  5312. end;
  5313. GetCurrentWordArea:=OK;
  5314. end;
  5315. function TCustomCodeEditor.GetCurrentWord : string;
  5316. var S: sw_astring;
  5317. StartP,EndP: TPoint;
  5318. begin
  5319. if GetCurrentWordArea(StartP,EndP)=false then
  5320. S:=''
  5321. else
  5322. begin
  5323. S:=GetLineText(StartP.Y);
  5324. S:=copy(S,StartP.X+1,EndP.X-StartP.X+1);
  5325. end;
  5326. GetCurrentWord:=S; {Note: AnsiString to ShortString convertion}
  5327. end;
  5328. procedure TCustomCodeEditor.StartSelect;
  5329. var P1,P2: TPoint;
  5330. begin
  5331. if ValidBlock=false then
  5332. begin
  5333. { SetSelection(SelStart,Limit);}
  5334. P1:=CurPos; P2:=CurPos; {P2.X:=length(GetLineText(P2.Y))+1;}
  5335. SetSelection(P1,P2);
  5336. end
  5337. else
  5338. SetSelection(CurPos,SelEnd);
  5339. if PointOfs(SelEnd)<PointOfs(SelStart) then
  5340. SetSelection(SelStart,SelStart);
  5341. CheckSels;
  5342. DrawView;
  5343. end;
  5344. procedure TCustomCodeEditor.EndSelect;
  5345. var P: TPoint;
  5346. { LS: sw_integer;}
  5347. begin
  5348. P:=CurPos;
  5349. { don't try to jump to end of line, not for now
  5350. LS:=length(GetLineText(P.Y));
  5351. if LS<P.X then P.X:=LS; }
  5352. SetSelection(SelStart,P);
  5353. CheckSels;
  5354. DrawView;
  5355. end;
  5356. procedure TCustomCodeEditor.DelSelect;
  5357. var LineDelta, LineCount, CurLine: Sw_integer;
  5358. StartX,EndX,LastX: Sw_integer;
  5359. S,Z: sw_astring;
  5360. SPos : TPoint;
  5361. begin
  5362. if IsReadOnly or (ValidBlock=false) then Exit;
  5363. Lock;
  5364. AddGroupedAction(eaDelBlock);
  5365. LineCount:=(SelEnd.Y-SelStart.Y)+1;
  5366. LineDelta:=0; LastX:=CurPos.X;
  5367. CurLine:=SelStart.Y;
  5368. { single line : easy }
  5369. if LineCount=1 then
  5370. begin
  5371. S:=GetDisplayText(CurLine);
  5372. StartX:=SelStart.X;
  5373. EndX:=SelEnd.X;
  5374. SetDisplayText(CurLine,RExpand(copy(S,1,StartX),StartX)
  5375. +copy(S,EndX+1,Length(S)));
  5376. if GetStoreUndo then
  5377. begin
  5378. SPos.X:=StartX;
  5379. SPos.Y:=CurLine;
  5380. AddAction(eaDeleteText,SPos,SPos,Copy(S,StartX+1,EndX-StartX),GetFlags);
  5381. end;
  5382. Inc(CurLine);
  5383. LastX:=SelStart.X;
  5384. end
  5385. { several lines : a bit less easy }
  5386. else
  5387. begin
  5388. S:=GetDisplayText(CurLine);
  5389. StartX:=SelStart.X;
  5390. EndX:=SelEnd.X;
  5391. Z:=GetDisplayText(CurLine+LineCount-1);
  5392. SetDisplayText(CurLine,RExpand(copy(S,1,StartX),StartX)
  5393. +copy(Z,EndX+1,Length(Z)));
  5394. if GetStoreUndo then
  5395. begin
  5396. SPos.X:=StartX;
  5397. SPos.Y:=CurLine;
  5398. AddAction(eaDeleteText,SPos,SPos,Copy(S,StartX+1,Length(S)),GetFlags);
  5399. S:=GetDisplayText(CurLine+LineCount-1);
  5400. end;
  5401. Inc(CurLine);
  5402. Inc(LineDelta);
  5403. LastX:=SelStart.X;
  5404. while (LineDelta<LineCount) do
  5405. begin
  5406. { delete the complete line }
  5407. DeleteLine(CurLine);
  5408. Inc(LineDelta);
  5409. end;
  5410. if GetStoreUndo then
  5411. begin
  5412. AddAction(eaInsertText,SPos,SPos,Copy(S,EndX+1,Length(S)),GetFlags);
  5413. end;
  5414. end;
  5415. HideSelect;
  5416. SetCurPtr(LastX,CurLine-1);
  5417. UpdateAttrs(CurPos.Y,attrAll);
  5418. DrawLines(CurPos.Y);
  5419. SetModified(true);
  5420. CloseGroupedAction(eaDelBlock);
  5421. UnLock;
  5422. end;
  5423. procedure TCustomCodeEditor.HideSelect;
  5424. begin
  5425. SetSelection(CurPos,CurPos);
  5426. DrawLines(Delta.Y);
  5427. end;
  5428. procedure TCustomCodeEditor.CopyBlock;
  5429. var Temp: PCodeEditor;
  5430. R: TRect;
  5431. begin
  5432. if IsReadOnly or (ValidBlock=false) then Exit;
  5433. Lock;
  5434. GetExtent(R);
  5435. AddGroupedAction(eaCopyBlock);
  5436. New(Temp, Init(R, nil, nil, nil,nil));
  5437. Temp^.InsertFrom(@Self);
  5438. (* Temp^.SelectAll(true);
  5439. { this selects one line too much because
  5440. we have a empty line at creation to avoid
  5441. negative line problems so we need to decrease SelEnd.Y }
  5442. Dec(Temp^.SelEnd.Y);*)
  5443. InsertFrom(Temp);
  5444. Dispose(Temp, Done);
  5445. CloseGroupedAction(eaCopyBlock);
  5446. UnLock;
  5447. end;
  5448. procedure TCustomCodeEditor.MoveBlock;
  5449. var Temp: PCodeEditor;
  5450. R: TRect;
  5451. OldPos: TPoint;
  5452. begin
  5453. if IsReadOnly then Exit;
  5454. if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
  5455. Lock;
  5456. AddGroupedAction(eaMoveBlock);
  5457. GetExtent(R);
  5458. New(Temp, Init(R, nil, nil, nil,nil));
  5459. Temp^.InsertFrom(@Self);
  5460. OldPos:=CurPos;
  5461. if CurPos.Y>SelStart.Y then
  5462. Dec(OldPos.Y,Temp^.GetLineCount-1);
  5463. DelSelect;
  5464. SetCurPtr(OldPos.X,OldPos.Y);
  5465. InsertFrom(Temp);
  5466. Dispose(Temp, Done);
  5467. CloseGroupedAction(eaMoveBlock);
  5468. UnLock;
  5469. end;
  5470. procedure TCustomCodeEditor.IndentBlock;
  5471. var
  5472. ey,i,Indlen : Sw_Integer;
  5473. S,Ind : Sw_AString;
  5474. Pos : Tpoint;
  5475. {WasPersistentBlocks : boolean;}
  5476. begin
  5477. if IsReadOnly then Exit;
  5478. if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
  5479. Lock;
  5480. AddGroupedAction(eaIndentBlock);
  5481. { as SetCurPtr commented out, no need take care of Persistent Blocks
  5482. WasPersistentBlocks:=IsFlagSet(efPersistentBlocks);
  5483. if not WasPersistentBlocks then
  5484. SetFlags(GetFlags or efPersistentBlocks); }
  5485. ey:=selend.y;
  5486. if selend.x=0 then
  5487. dec(ey);
  5488. S:='';
  5489. { If AutoIndent try to align first line to
  5490. last line before selection }
  5491. { DISABLED created problems PM
  5492. if IsFlagSet(efAutoIndent) and (SelStart.Y>0) then
  5493. begin
  5494. i:=SelStart.Y-1;
  5495. while (S='') and (i>=0) do
  5496. begin
  5497. S:=GetDisplayText(i);
  5498. dec(i);
  5499. end;
  5500. if (S='') or (S[1]<>' ') then
  5501. Ind:=' '
  5502. else
  5503. begin
  5504. i:=1;
  5505. while (i<=Length(S)) and (S[i]=' ') do
  5506. inc(i);
  5507. indlen:=i;
  5508. S:=GetDisplayText(SelStart.Y);
  5509. i:=1;
  5510. while (i<=Length(S)) and (S[i]=' ') do
  5511. inc(i);
  5512. indlen:=indlen-i;
  5513. if indlen<=0 then
  5514. indlen:=1;
  5515. Ind:=CharStr(' ',indlen);
  5516. end;
  5517. end
  5518. else
  5519. Ind:=' ';}
  5520. Indlen:=GetIndentSize;
  5521. {selection Start and End move along}
  5522. if SelStart.X>0 then inc(SelStart.X,Indlen);
  5523. if SelEnd.X>0 then inc(SelEnd.X,Indlen);
  5524. Ind:=CharStr(' ',Indlen);
  5525. for i:=selstart.y to ey do
  5526. begin
  5527. S:=GetLineText(i);
  5528. SetLineText(i,Ind+S);
  5529. Pos.X:=0;Pos.Y:=i;
  5530. AddAction(eaInsertText,Pos,Pos,Ind,GetFlags);
  5531. end;
  5532. { this removes selection if Shift is pressed as well and we do not change cursor position anyway
  5533. SetCurPtr(CurPos.X,CurPos.Y); }
  5534. {after SetCurPtr return PersistentBlocks as it was before}
  5535. { as SetCurPtr commented out, no need take care of Persistent Blocks
  5536. if not WasPersistentBlocks then
  5537. SetFlags(GetFlags and (not longword(efPersistentBlocks))); }
  5538. { must be added manually here PM }
  5539. AddAction(eaMoveCursor,Pos,CurPos,'',GetFlags);
  5540. UpdateAttrsRange(SelStart.Y,SelEnd.Y,attrAll);
  5541. DrawLines(CurPos.Y);
  5542. SetModified(true);
  5543. CloseGroupedAction(eaIndentBlock);
  5544. UnLock;
  5545. end;
  5546. procedure TCustomCodeEditor.UnindentBlock;
  5547. var
  5548. ey,i,j,k,indlen : Sw_integer;
  5549. S : Sw_AString;
  5550. Pos : TPoint;
  5551. {WasPersistentBlocks : boolean;}
  5552. begin
  5553. if IsReadOnly then Exit;
  5554. if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
  5555. Lock;
  5556. AddGroupedAction(eaUnindentBlock);
  5557. { as SetCurPtr commented out, no need take care of Persistent Blocks
  5558. WasPersistentBlocks:=IsFlagSet(efPersistentBlocks);
  5559. if not WasPersistentBlocks then
  5560. SetFlags(GetFlags or efPersistentBlocks);
  5561. }
  5562. ey:=selend.y;
  5563. if selend.x=0 then
  5564. dec(ey);
  5565. { If AutoIndent try to align first line to
  5566. last line before selection }
  5567. { Disabled created problems
  5568. if IsFlagSet(efAutoIndent) and (SelStart.Y>0) then
  5569. begin
  5570. S:=GetDisplayText(SelStart.Y);
  5571. i:=1;
  5572. while (i<=Length(S)) and (S[i]=' ') do
  5573. inc(i);
  5574. indlen:=i-1;
  5575. i:=SelStart.Y-1;
  5576. S:='';
  5577. while (S='') and (i>=0) do
  5578. begin
  5579. if Trim(Copy(GetDisplayText(i),1,indlen))='' then
  5580. S:=''
  5581. else
  5582. S:=GetDisplayText(i);
  5583. dec(i);
  5584. end;
  5585. if (S='') then
  5586. Indlen:=1
  5587. else
  5588. begin
  5589. i:=1;
  5590. while (i<=Length(S)) and (S[i]=' ') do
  5591. inc(i);
  5592. indlen:=indlen-i+1;
  5593. if indlen<=0 then
  5594. indlen:=1;
  5595. end;
  5596. end
  5597. else
  5598. Indlen:=1;}
  5599. Indlen:=GetIndentSize;
  5600. {selection Start and End move along}
  5601. if SelStart.X>0 then dec(SelStart.X,Indlen);
  5602. if SelStart.X<0 then SelStart.X:=0;
  5603. if SelEnd.X>0 then dec(SelEnd.X,Indlen);
  5604. if SelEnd.X<0 then begin SelEnd.X:=0; inc(SelEnd.Y); end;
  5605. {do indent line by line}
  5606. for i:=selstart.y to ey do
  5607. begin
  5608. S:=GetLineText(i);
  5609. k:=0;
  5610. for j:=1 to indlen do
  5611. if (length(s)>1) and (S[1]=' ') then
  5612. begin
  5613. Delete(s,1,1);
  5614. inc(k);
  5615. end;
  5616. SetLineText(i,S);
  5617. if k>0 then
  5618. begin
  5619. Pos.Y:=i;
  5620. Pos.X:=0;
  5621. AddAction(eaDeleteText,Pos,Pos,CharStr(' ',k),GetFlags);
  5622. end;
  5623. end;
  5624. { Removes selection if Shift is pressed as well and we do not change cursor position anyway
  5625. SetCurPtr(CurPos.X,CurPos.Y); }
  5626. {after SetCurPtr return PersistentBlocks as it was before}
  5627. { as SetCurPtr commented out, no need take care of Persistent Blocks
  5628. if not WasPersistentBlocks then
  5629. SetFlags(GetFlags and (not longword(efPersistentBlocks)));
  5630. }
  5631. UpdateAttrsRange(SelStart.Y,SelEnd.Y,attrAll);
  5632. DrawLines(CurPos.Y);
  5633. SetModified(true);
  5634. CloseGroupedAction(eaUnindentBlock);
  5635. UnLock;
  5636. end;
  5637. procedure TCustomCodeEditor.SelectWord;
  5638. const WordChars = ['A'..'Z','a'..'z','0'..'9','_'];
  5639. var S : String;
  5640. StartPos,EndPos : byte;
  5641. A,B: TPoint;
  5642. begin
  5643. A:=CurPos;
  5644. B:=CurPos;
  5645. S:=GetDisplayText(A.Y);
  5646. StartPos:=A.X+1;
  5647. EndPos:=StartPos;
  5648. if not (S[StartPos] in WordChars) then
  5649. exit
  5650. else
  5651. begin
  5652. While (StartPos>1) and (S[StartPos-1] in WordChars) do
  5653. Dec(StartPos);
  5654. While (EndPos<Length(S)) and (S[EndPos+1] in WordChars) do
  5655. Inc(EndPos);
  5656. A.X:=StartPos-1;
  5657. B.X:=EndPos;
  5658. SetSelection(A,B);
  5659. end;
  5660. end;
  5661. procedure TCustomCodeEditor.SelectLine;
  5662. var A,B: TPoint;
  5663. begin
  5664. if CurPos.Y<GetLineCount then
  5665. begin
  5666. A.Y:=CurPos.Y; A.X:=0;
  5667. B.Y:=CurPos.Y+1; B.X:=0;
  5668. SetSelection(A,B);
  5669. end;
  5670. end;
  5671. procedure TCustomCodeEditor.WriteBlock;
  5672. var FileName: string;
  5673. S: PBufStream;
  5674. begin
  5675. if ValidBlock=false then Exit;
  5676. FileName:='';
  5677. if EditorDialog(edWriteBlock, @FileName) <> cmCancel then
  5678. begin
  5679. FileName := FExpand(FileName);
  5680. New(S, Init(FileName, stCreate, 4096));
  5681. if (S=nil) or (S^.Status<>stOK) then
  5682. EditorDialog(edCreateError,@FileName)
  5683. else
  5684. if SaveAreaToStream(S,SelStart,SelEnd)=false then
  5685. EditorDialog(edWriteError,@FileName);
  5686. if Assigned(S) then Dispose(S, Done);
  5687. end;
  5688. end;
  5689. procedure TCustomCodeEditor.ReadBlock;
  5690. var FileName: string;
  5691. S: PFastBufStream;
  5692. E: PCodeEditor;
  5693. R: TRect;
  5694. begin
  5695. if IsReadOnly then Exit;
  5696. FileName:='';
  5697. if EditorDialog(edReadBlock, @FileName) <> cmCancel then
  5698. begin
  5699. FileName := FExpand(FileName);
  5700. New(S, Init(FileName, stOpenRead, 4096));
  5701. if (S=nil) or (S^.Status<>stOK) then
  5702. EditorDialog(edReadError,@FileName)
  5703. else
  5704. begin
  5705. R.Assign(0,0,0,0);
  5706. New(E, Init(R,nil,nil,nil,nil));
  5707. AddGroupedAction(eaReadBlock);
  5708. if E^.LoadFromStream(S)=false then
  5709. EditorDialog(edReadError,@FileName)
  5710. else
  5711. begin
  5712. E^.SelectAll(true);
  5713. Self.InsertFrom(E);
  5714. end;
  5715. CloseGroupedAction(eaReadBlock);
  5716. Dispose(E, Done);
  5717. end;
  5718. if Assigned(S) then Dispose(S, Done);
  5719. end;
  5720. end;
  5721. procedure TCustomCodeEditor.PrintBlock;
  5722. begin
  5723. NotImplemented; Exit;
  5724. end;
  5725. function TCustomCodeEditor.SelectCodeTemplate(var ShortCut: string): boolean;
  5726. begin
  5727. { Abstract }
  5728. SelectCodeTemplate:=false;
  5729. end;
  5730. procedure TCustomCodeEditor.ExpandCodeTemplate;
  5731. var Line : sw_astring;
  5732. ShortCutInEditor,ShortCut: string;
  5733. X,Y,I,LineIndent: sw_integer;
  5734. CodeLines: PUnsortedStringCollection;
  5735. CanJump: boolean;
  5736. CP: TPoint;
  5737. begin
  5738. {
  5739. The usage of editing primitives in this routine make it pretty slow, but
  5740. its speed is still acceptable and they make the implementation of Undo
  5741. much easier... - Gabor
  5742. }
  5743. if IsReadOnly then Exit;
  5744. Lock;
  5745. CP.X:=-1; CP.Y:=-1;
  5746. Line:=GetDisplayText(CurPos.Y);
  5747. X:=CurPos.X; ShortCut:='';
  5748. if X<=length(Line) then
  5749. while (X>0) and (Line[X] in (NumberChars+AlphaChars)) do
  5750. begin
  5751. ShortCut:=Line[X]+ShortCut;
  5752. Dec(X);
  5753. end;
  5754. ShortCutInEditor:=ShortCut;
  5755. New(CodeLines, Init(10,10));
  5756. if (ShortCut='') or (not TranslateCodeTemplate(ShortCut,CodeLines)) then
  5757. if SelectCodeTemplate(ShortCut) then
  5758. TranslateCodeTemplate(ShortCut,CodeLines);
  5759. if CodeLines^.Count>0 then
  5760. begin
  5761. LineIndent:=X;
  5762. SetCurPtr(X,CurPos.Y);
  5763. if Copy(ShortCut,1,length(ShortCutInEditor))=ShortCutInEditor then
  5764. begin
  5765. for I:=1 to length(ShortCutInEditor) do
  5766. DelChar;
  5767. end
  5768. else
  5769. { restore correct position }
  5770. SetCurPtr(X+Length(ShortCutInEditor),CurPos.Y);
  5771. for Y:=0 to CodeLines^.Count-1 do
  5772. begin
  5773. Line:=GetStr(CodeLines^.At(Y));
  5774. CanJump:=false;
  5775. if (Y>0) then
  5776. begin
  5777. CanJump:=Trim(GetLineText(CurPos.Y))='';
  5778. if CanJump=false then
  5779. begin
  5780. (* for X:=1 to LineIndent do { indent template lines to align }
  5781. AddChar(' '); { them to the first line }*)
  5782. InsertText(CharStr(' ',LineIndent));
  5783. end
  5784. else
  5785. SetCurPtr(CurPos.X+LineIndent,CurPos.Y);
  5786. end;
  5787. I:=Pos(CodeTemplateCursorChar,Line);
  5788. if I>0 then
  5789. begin
  5790. Delete(Line,I,1);
  5791. CP.X:=CurPos.X+I-1;
  5792. CP.Y:=CurPos.Y;
  5793. end;
  5794. InsertText(Line);
  5795. if Y<CodeLines^.Count-1 then
  5796. begin
  5797. InsertNewLine; { line break }
  5798. if CanJump=false then
  5799. begin
  5800. while CurPos.X>0 do { unindent }
  5801. begin
  5802. SetCurPtr(CurPos.X-1,CurPos.Y);
  5803. DelChar;
  5804. end;
  5805. end
  5806. else
  5807. SetCurPtr(0,CurPos.Y);
  5808. end;
  5809. end;
  5810. end;
  5811. Dispose(CodeLines, Done);
  5812. if (CP.X<>-1) and (CP.Y<>-1) then
  5813. SetCurPtr(CP.X,CP.Y);
  5814. UnLock;
  5815. end;
  5816. procedure TCustomCodeEditor.AddChar(C: AnsiChar);
  5817. const OpenBrackets : string[10] = '[({';
  5818. CloseBrackets : string[10] = '])}';
  5819. var S,SC,TabS: sw_astring;
  5820. BI: byte;
  5821. CI,TabStart,LocTabSize : Sw_integer;
  5822. SP: TPoint;
  5823. HoldUndo : boolean;
  5824. begin
  5825. if IsReadOnly then Exit;
  5826. Lock;
  5827. if not (Clipboard=@Self) and IsFlagSet(efOverwriteBlocks) and InSelectionArea then
  5828. DelSelect; {delete selection before}
  5829. SP:=CurPos;
  5830. HoldUndo:=GetStoreUndo;
  5831. SetStoreUndo(false);
  5832. if (C<>TAB) or IsFlagSet(efUseTabCharacters) then
  5833. SC:=C
  5834. else
  5835. begin
  5836. LocTabSize:=GetTabSize - (CurPos.X mod GetTabSize);
  5837. if (CurPos.Y<=1) or not IsFlagSet(efAutoIndent) then
  5838. SC:=CharStr(' ',LocTabSize)
  5839. else
  5840. begin
  5841. S:=GetLineText(CurPos.Y-1);
  5842. BI:=CurPos.X+1;
  5843. while (BI<=Length(S)) and (S[BI]=' ') do
  5844. inc(BI);
  5845. if (BI=CurPos.X+1) or (BI>Length(S)) then
  5846. SC:=CharStr(' ',LocTabSize)
  5847. else
  5848. SC:=CharStr(' ',BI-CurPos.X-1);
  5849. end;
  5850. end;
  5851. S:=GetLineText(CurPos.Y);
  5852. if CharIdxToLinePos(CurPos.Y,length(S))<CurPos.X then
  5853. begin
  5854. S:=S+CharStr(' ',CurPos.X-CharIdxToLinePos(CurPos.Y,length(S)){-1});
  5855. SetLineText(CurPos.Y,S);
  5856. end;
  5857. CI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
  5858. {$if sizeof(sw_astring)>8 only if ShortString}
  5859. if CI>High(S) then
  5860. begin
  5861. Unlock;
  5862. exit;
  5863. end;
  5864. {$endif}
  5865. SP.X:=CharIdxToLinePos(CurPos.Y,CI); {actual changes are going to be here (tab space adjustment)}
  5866. if (CI>0) and (S[CI]=TAB) and not IsFlagSet(efUseTabCharacters) then
  5867. begin
  5868. if CI=1 then
  5869. TabStart:=0
  5870. else
  5871. TabStart:=CharIdxToLinePos(CurPos.Y,CI-1)+1;
  5872. if SC=Tab then TabS:=Tab else
  5873. TabS:=CharStr(' ',CurPos.X-TabStart);
  5874. SetLineText(CurPos.Y,copy(S,1,CI-1)+TabS+SC+copy(S,CI+1,Length(S)));
  5875. SetCurPtr(CharIdxToLinePos(CurPos.Y,CI+length(TabS)+length(SC)),CurPos.Y);
  5876. end
  5877. else
  5878. begin
  5879. if Overwrite and (CI<=length(S)) then
  5880. begin
  5881. SetLineText(CurPos.Y,copy(S,1,CI-1)+SC+copy(S,CI+length(SC),Length(S)));
  5882. end
  5883. else
  5884. SetLineText(CurPos.Y,copy(S,1,CI-1)+SC+copy(S,CI,Length(S)));
  5885. SetCurPtr(CharIdxToLinePos(CurPos.Y,CI+length(SC)),CurPos.Y);
  5886. end;
  5887. { must be before CloseBrackets !! }
  5888. SetStoreUndo(HoldUndo);
  5889. if Overwrite then
  5890. Addaction(eaOverwriteText,SP,CurPos,Copy(S,CI,length(SC)),GetFlags)
  5891. else
  5892. Addaction(eaInsertText,SP,CurPos,SC,GetFlags);
  5893. SetStoreUndo(false);
  5894. if IsFlagSet(efAutoBrackets) then
  5895. begin
  5896. BI:=Pos(C,OpenBrackets);
  5897. if (BI>0) then
  5898. begin
  5899. SetStoreUndo(HoldUndo);
  5900. AddChar(CloseBrackets[BI]);
  5901. SetStoreUndo(false);
  5902. SetCurPtr(CurPos.X-1,CurPos.Y);
  5903. end;
  5904. end;
  5905. UpdateAttrs(CurPos.Y,attrAll);
  5906. if GetInsertMode then
  5907. AdjustSelection(CurPos.X-SP.X,CurPos.Y-SP.Y);
  5908. DrawLines(CurPos.Y);
  5909. SetStoreUndo(HoldUndo);
  5910. SetModified(true);
  5911. UnLock;
  5912. end;
  5913. const
  5914. linelimit = 200;
  5915. procedure TCustomCodeEditor.PasteText(P:PAnsiChar; ASize:sw_integer);
  5916. var
  5917. StorePos : TPoint;
  5918. first : boolean;
  5919. IsNewLine: boolean;
  5920. procedure InsertStringWrap(const s: sw_astring; var i : Longint);
  5921. var
  5922. BPos,EPos: TPoint;
  5923. begin
  5924. if first then
  5925. begin
  5926. { we need to cut the line in two
  5927. if not at end of line PM }
  5928. if IsNewLine then
  5929. InsertNewLine;
  5930. SetCurPtr(StorePos.X,StorePos.Y);
  5931. InsertText(s);
  5932. first:=false;
  5933. end
  5934. else
  5935. begin
  5936. Inc(i);
  5937. if IsNewLine then
  5938. begin
  5939. InsertLine(i,s);
  5940. BPos.X:=0;BPos.Y:=i;
  5941. EPOS.X:=Length(s);EPos.Y:=i;
  5942. AddAction(eaInsertLine,BPos,EPos,GetDisplayText(i),GetFlags);
  5943. end else
  5944. begin
  5945. SetCurPtr(0,i);
  5946. InsertText(s);
  5947. end;
  5948. end;
  5949. end;
  5950. var
  5951. l,i,len,len10 : longint;
  5952. p10,p2,p13 : PAnsiChar;
  5953. s : sw_astring;
  5954. begin
  5955. Lock;
  5956. first:=true;
  5957. StorePos:=CurPos;
  5958. i:=CurPos.Y;
  5959. if ASize>500 then
  5960. PushInfo(msg_readingwinclipboard);
  5961. AddGroupedAction(eaPasteWin);
  5962. if not (Clipboard=@Self) and IsFlagSet(efOverwriteBlocks) and InSelectionArea then
  5963. DelSelect; {delete selection before paste}
  5964. p2:=p;
  5965. len:=strlen(p2);
  5966. // issue lines ((#13)#10 terminated) of maximally "linelimit" chars.
  5967. // does not take initial X position into account
  5968. repeat
  5969. p13:=strpos(p2,#13);
  5970. p10:=strpos(p2,#10);
  5971. {$if sizeof(sw_astring)>8 only if ShortString lines}
  5972. if len> linelimit then
  5973. len:=linelimit;
  5974. {$endif}
  5975. if not assigned(p10) and assigned(p13) then
  5976. p10:=p13;
  5977. IsNewLine:=false;
  5978. if assigned(p10) then
  5979. begin
  5980. IsNewLine:=true;
  5981. len10:=p10-p2;
  5982. if len10<len then
  5983. begin
  5984. if p13+1=p10 then
  5985. dec(len10);
  5986. len:=len10;
  5987. end
  5988. else
  5989. p10:=nil; // signal no cleanup
  5990. end;
  5991. setlength(s,len);
  5992. if len>0 then
  5993. move(p2^,s[1],len);
  5994. // cleanup
  5995. if assigned(p10) then
  5996. p2:=p10+1
  5997. else
  5998. inc(p2,len);
  5999. insertstringwrap(s,i);
  6000. len:=strlen(p2);
  6001. until len=0;
  6002. SetCurPtr(StorePos.X,StorePos.Y); // y+i to get after paste?
  6003. SetModified(true);
  6004. UpdateAttrs(StorePos.Y,attrAll);
  6005. CloseGroupedAction(eaPasteWin);
  6006. Update;
  6007. if ASize>500 then
  6008. PopInfo;
  6009. DrawView;
  6010. UnLock;
  6011. end;
  6012. {$ifdef WinClipSupported}
  6013. function TCustomCodeEditor.ClipPasteWin: Boolean;
  6014. var
  6015. OK: boolean;
  6016. l : longint;
  6017. p : PAnsiChar;
  6018. begin
  6019. Lock;
  6020. OK:=WinClipboardSupported;
  6021. if OK then
  6022. begin
  6023. l:=GetTextWinClipboardSize;
  6024. if l=0 then
  6025. OK:=false
  6026. else
  6027. OK:=GetTextWinClipBoardData(p,l);
  6028. if OK then
  6029. begin
  6030. PasteText(p,l);
  6031. { we must free the allocated memory }
  6032. freemem(p,l);
  6033. end;
  6034. end;
  6035. ClipPasteWin:=OK;
  6036. UnLock;
  6037. end;
  6038. function TCustomCodeEditor.ClipCopyWin: Boolean;
  6039. var OK,ShowInfo: boolean;
  6040. p,p2 : PAnsiChar;
  6041. s : sw_astring;
  6042. i,str_begin,str_end,NumLines,PcLength : longint;
  6043. begin
  6044. NumLines:=SelEnd.Y-SelStart.Y;
  6045. if (NumLines>0) or (SelEnd.X>SelStart.X) then
  6046. Inc(NumLines);
  6047. if NumLines=0 then
  6048. exit;
  6049. Lock;
  6050. ShowInfo:=SelEnd.Y-SelStart.Y>50;
  6051. if ShowInfo then
  6052. PushInfo(msg_copyingwinclipboard);
  6053. { First calculate needed size }
  6054. { for newlines first + 1 for terminal #0 }
  6055. PcLength:=Length(EOL)*(NumLines-1)+1;
  6056. { overestimated but can not be that big PM }
  6057. for i:=SelStart.Y to SelEnd.Y do
  6058. PCLength:=PCLength+Length(GetLineText(i));
  6059. getmem(p,PCLength);
  6060. i:=SelStart.Y;
  6061. s:=GetLineText(i);
  6062. str_begin:=LinePosToCharIdx(i,SelStart.X);
  6063. if SelEnd.Y>SelStart.Y then
  6064. str_end:=Length(S)
  6065. else
  6066. str_end:=LinePosToCharIdx(i,SelEnd.X)-1;
  6067. s:=copy(s,str_begin,str_end-str_begin+1);
  6068. {$if sizeof(sw_astring)>8}
  6069. strpcopy(p,s);
  6070. {$else}
  6071. s:=s+#0;
  6072. Move(S[1],P^,Length(S));
  6073. {$endif}
  6074. p2:=strend(p);
  6075. inc(i);
  6076. while i<SelEnd.Y do
  6077. begin
  6078. s:=EOL+GetLineText(i);
  6079. {$if sizeof(sw_astring)>8}
  6080. strpcopy(p2,s);
  6081. {$else}
  6082. s:=s+#0;
  6083. Move(S[1],P2^,Length(S));
  6084. {$endif}
  6085. p2:=strend(p2);
  6086. Inc(i);
  6087. end;
  6088. if SelEnd.Y>SelStart.Y then
  6089. begin
  6090. s:=copy(GetLineText(i),1,LinePosToCharIdx(i,SelEnd.X)-1);
  6091. {$if sizeof(sw_astring)>8}
  6092. strpcopy(p2,EOL+s);
  6093. {$else}
  6094. s:=EOL+s+#0;
  6095. Move(S[1],P2^,Length(S));
  6096. {$endif}
  6097. end;
  6098. OK:=WinClipboardSupported;
  6099. if OK then
  6100. begin
  6101. OK:=SetTextWinClipBoardData(p,strlen(p));
  6102. end;
  6103. ClipCopyWin:=OK;
  6104. if ShowInfo then
  6105. PopInfo;
  6106. Freemem(p,PCLength);
  6107. UnLock;
  6108. end;
  6109. {$endif WinClipSupported}
  6110. function TCustomCodeEditor.ClipCopy: Boolean;
  6111. var ShowInfo,CanPaste: boolean;
  6112. begin
  6113. Lock;
  6114. {AddGroupedAction(eaCopy);
  6115. can we undo a copy ??
  6116. maybe as an Undo Paste in Clipboard !! }
  6117. clipcopy:=false;
  6118. showinfo:=false;
  6119. if (clipboard<>nil) and (clipboard<>@self) then
  6120. begin
  6121. ShowInfo:=SelEnd.Y-SelStart.Y>50;
  6122. if ShowInfo then
  6123. PushInfo(msg_copyingclipboard);
  6124. clipcopy:=Clipboard^.InsertFrom(@Self);
  6125. if ShowInfo then
  6126. PopInfo;
  6127. {Enable paste command.}
  6128. CanPaste:=((Clipboard^.SelStart.X<>Clipboard^.SelEnd.X) or
  6129. (Clipboard^.SelStart.Y<>Clipboard^.SelEnd.Y));
  6130. SetCmdState(FromClipCmds,CanPaste);
  6131. end;
  6132. UnLock;
  6133. end;
  6134. procedure TCustomCodeEditor.ClipCut;
  6135. var
  6136. ShowInfo,CanPaste : boolean;
  6137. begin
  6138. if IsReadOnly then Exit;
  6139. Lock;
  6140. AddGroupedAction(eaCut);
  6141. DontConsiderShiftState:=true;
  6142. if (clipboard<>nil) and (clipboard<>@self) then
  6143. begin
  6144. ShowInfo:=SelEnd.Y-SelStart.Y>50;
  6145. if ShowInfo then
  6146. PushInfo(msg_cutting);
  6147. if Clipboard^.InsertFrom(@Self) then
  6148. begin
  6149. if not IsClipBoard then
  6150. DelSelect;
  6151. SetModified(true);
  6152. end;
  6153. if ShowInfo then
  6154. PopInfo;
  6155. CanPaste:=((Clipboard^.SelStart.X<>Clipboard^.SelEnd.X) or
  6156. (Clipboard^.SelStart.Y<>Clipboard^.SelEnd.Y));
  6157. SetCmdState(FromClipCmds,CanPaste);
  6158. end;
  6159. CloseGroupedAction(eaCut);
  6160. UnLock;
  6161. DontConsiderShiftState:=false;
  6162. end;
  6163. procedure TCustomCodeEditor.ClipPaste;
  6164. var
  6165. ShowInfo : boolean;
  6166. begin
  6167. if IsReadOnly then Exit;
  6168. DontConsiderShiftState:=true;
  6169. Lock;
  6170. AddGroupedAction(eaPaste);
  6171. if Clipboard<>nil then
  6172. begin
  6173. ShowInfo:=Clipboard^.SelEnd.Y-Clipboard^.SelStart.Y>50;
  6174. if ShowInfo then
  6175. PushInfo(msg_pastingclipboard);
  6176. InsertFrom(Clipboard);
  6177. if ShowInfo then
  6178. PopInfo;
  6179. end;
  6180. CloseGroupedAction(eaPaste);
  6181. UnLock;
  6182. DontConsiderShiftState:=false;
  6183. end;
  6184. procedure TCustomCodeEditor.Undo;
  6185. begin
  6186. NotImplemented; Exit;
  6187. end;
  6188. procedure TCustomCodeEditor.Redo;
  6189. begin
  6190. NotImplemented; Exit;
  6191. end;
  6192. procedure TCustomCodeEditor.GotoLine;
  6193. const
  6194. GotoRec: TGotoLineDialogRec = (LineNo:'1';Lines:0); {keep previous goto line number}
  6195. begin
  6196. with GotoRec do
  6197. begin
  6198. Lines:=GetLineCount;
  6199. {Linecount can be 0, but in that case there still is a cursor blinking in top
  6200. of the window, which will become line 1 as soon as sometype hits a key.}
  6201. if lines=0 then
  6202. lines:=1;
  6203. if EditorDialog(edGotoLine, @GotoRec) <> cmCancel then
  6204. begin
  6205. Lock;
  6206. SetCurPtr(0,StrToInt(LineNo)-1);
  6207. TrackCursor(do_centre);
  6208. UnLock;
  6209. end;
  6210. end;
  6211. end;
  6212. procedure TCustomCodeEditor.Find;
  6213. var
  6214. FindRec: TFindDialogRec;
  6215. DoConf: boolean;
  6216. CurrentWord : string;
  6217. begin
  6218. with FindRec do
  6219. begin
  6220. Find := FindStr;
  6221. CurrentWord:=GetCurrentWord;
  6222. if CurrentWord<>'' then
  6223. Find:=CurrentWord;
  6224. {$ifdef TEST_REGEXP}
  6225. Options := ((FindFlags and ffmOptionsFind) shr ffsOptions) or
  6226. ((FindFlags and ffUseRegExp) shr ffsUseRegExpFind);
  6227. {$else not TEST_REGEXP}
  6228. Options := (FindFlags and ffmOptions) shr ffsOptions;
  6229. {$endif TEST_REGEXP}
  6230. Direction := (FindFlags and ffmDirection) shr ffsDirection;
  6231. Scope := (FindFlags and ffmScope) shr ffsScope;
  6232. Origin := (FindFlags and ffmOrigin) shr ffsOrigin;
  6233. DoConf:= (FindFlags and ffPromptOnReplace)<>0;
  6234. FindReplaceEditor:=@self;
  6235. if EditorDialog(edFind, @FindRec) <> cmCancel then
  6236. begin
  6237. FindStr := Find;
  6238. {$ifdef TEST_REGEXP}
  6239. FindFlags := ((Options and ffmOptionsFind) shl ffsOptions) or (Direction shl ffsDirection) or
  6240. ((Options and ffmUseRegExpFind) shl ffsUseRegExpFind) or
  6241. (Scope shl ffsScope) or (Origin shl ffsOrigin);
  6242. {$else : not TEST_REGEXP}
  6243. FindFlags := ((Options and ffmOptions) shl ffsOptions) or (Direction shl ffsDirection) or
  6244. (Scope shl ffsScope) or (Origin shl ffsOrigin);
  6245. {$endif TEST_REGEXP}
  6246. FindFlags := FindFlags and not ffDoReplace;
  6247. if DoConf then
  6248. FindFlags := (FindFlags or ffPromptOnReplace);
  6249. SearchRunCount:=0;
  6250. if FindStr<>'' then
  6251. DoSearchReplace
  6252. else
  6253. EditorDialog(edSearchFailed,nil);
  6254. end;
  6255. FindReplaceEditor:=nil;
  6256. end;
  6257. end;
  6258. procedure TCustomCodeEditor.Replace;
  6259. var
  6260. ReplaceRec: TReplaceDialogRec;
  6261. Re: word;
  6262. begin
  6263. if IsReadOnly then Exit;
  6264. with ReplaceRec do
  6265. begin
  6266. Find := FindStr;
  6267. if GetCurrentWord<>'' then
  6268. Find:=GetCurrentWord;
  6269. Replace := ReplaceStr;
  6270. {$ifdef TEST_REGEXP}
  6271. Options := (FindFlags and ffmOptions) shr ffsOptions or
  6272. (FindFlags and ffUseRegExp) shr ffsUseRegExpReplace;
  6273. {$else not TEST_REGEXP}
  6274. Options := (FindFlags and ffmOptions) shr ffsOptions;
  6275. {$endif TEST_REGEXP}
  6276. Direction := (FindFlags and ffmDirection) shr ffsDirection;
  6277. Scope := (FindFlags and ffmScope) shr ffsScope;
  6278. Origin := (FindFlags and ffmOrigin) shr ffsOrigin;
  6279. FindReplaceEditor:=@self;
  6280. Re:=EditorDialog(edReplace, @ReplaceRec);
  6281. FindReplaceEditor:=nil;
  6282. if Re <> cmCancel then
  6283. begin
  6284. FindStr := Find;
  6285. ReplaceStr := Replace;
  6286. FindFlags := (Options shl ffsOptions) or (Direction shl ffsDirection) or
  6287. {$ifdef TEST_REGEXP}
  6288. ((Options and ffmUseRegExpReplace) shl ffsUseRegExpReplace) or
  6289. {$endif TEST_REGEXP}
  6290. (Scope shl ffsScope) or (Origin shl ffsOrigin);
  6291. FindFlags := FindFlags or ffDoReplace;
  6292. if Re = cmYes then
  6293. FindFlags := FindFlags or ffReplaceAll;
  6294. SearchRunCount:=0;
  6295. if FindStr<>'' then
  6296. DoSearchReplace
  6297. else
  6298. EditorDialog(edSearchFailed,nil);
  6299. end;
  6300. end;
  6301. end;
  6302. procedure TCustomCodeEditor.DoSearchReplace;
  6303. var S: sw_astring;
  6304. DX,DY,P,Y,X: sw_integer;
  6305. Count: sw_integer;
  6306. Found,CanExit: boolean;
  6307. SForward,DoReplace,DoReplaceAll: boolean;
  6308. {$ifdef TEST_REGEXP}
  6309. UseRegExp : boolean;
  6310. RegExpEngine : TRegExprEngine;
  6311. RegExpFlags : tregexprflags;
  6312. regexpindex,regexplen : longint;
  6313. findstrpchar : PAnsiChar;
  6314. {$endif TEST_REGEXP}
  6315. LeftOK,RightOK: boolean;
  6316. FoundCount: sw_integer;
  6317. A,B: TPoint;
  6318. AreaStart,AreaEnd: TPoint;
  6319. CanReplace,Confirm: boolean;
  6320. Re: word;
  6321. IFindStr : string;
  6322. BT : BTable;
  6323. Overwriting : boolean;
  6324. function ContainsText(const SubS:string;var S: sw_astring; Start: Sw_integer): Sw_integer;
  6325. var
  6326. P: Sw_Integer;
  6327. begin
  6328. if Start<=0 then
  6329. P:=0
  6330. else
  6331. begin
  6332. if SForward then
  6333. begin
  6334. if Start>length(s) then
  6335. P:=0
  6336. else if FindFlags and ffCaseSensitive<>0 then
  6337. P:=BMFScan(S[Start],length(s)+1-Start,FindStr,Bt)+1
  6338. else
  6339. P:=BMFIScan(S[Start],length(s)+1-Start,IFindStr,Bt)+1;
  6340. if P>0 then
  6341. Inc(P,Start-1);
  6342. end
  6343. else
  6344. begin
  6345. if start>length(s) then
  6346. start:=length(s);
  6347. if FindFlags and ffCaseSensitive<>0 then
  6348. P:=BMBScan(S[1],Start,FindStr,Bt)+1
  6349. else
  6350. P:=BMBIScan(S[1],Start,IFindStr,Bt)+1;
  6351. end;
  6352. end;
  6353. ContainsText:=P;
  6354. end;
  6355. function InArea(X,Y: sw_integer): boolean;
  6356. begin
  6357. InArea:=((AreaStart.Y=Y) and (AreaStart.X<=X)) or
  6358. ((AreaStart.Y<Y) and (Y<AreaEnd.Y)) or
  6359. ((AreaEnd.Y=Y) and (X<=AreaEnd.X));
  6360. end;
  6361. var CurDY: sw_integer;
  6362. begin
  6363. if FindStr='' then
  6364. begin
  6365. Find;
  6366. { Find will call DoFindReplace at end again
  6367. so we need to exit directly now PM }
  6368. exit;
  6369. end;
  6370. Inc(SearchRunCount);
  6371. SForward:=(FindFlags and ffmDirection)=ffForward;
  6372. DoReplace:=(FindFlags and ffDoReplace)<>0;
  6373. Confirm:=(FindFlags and ffPromptOnReplace)<>0;
  6374. DoReplaceAll:=(FindFlags and ffReplaceAll)<>0;
  6375. {$ifdef TEST_REGEXP}
  6376. UseRegExp:=(FindFlags and ffUseRegExp)<>0;
  6377. if UseRegExp then
  6378. begin
  6379. if FindFlags and ffCaseSensitive<>0 then
  6380. RegExpFlags:=[ref_caseinsensitive]
  6381. else
  6382. RegExpFlags:=[];
  6383. getmem(findstrpchar,length(findstr)+1);
  6384. strpcopy(findstrpchar,findstr);
  6385. RegExpEngine:=GenerateRegExprEngine(findstrpchar,RegExpFlags);
  6386. strdispose(findstrpchar);
  6387. end;
  6388. {$endif TEST_REGEXP}
  6389. Count:=GetLineCount;
  6390. FoundCount:=0;
  6391. { Empty file ? }
  6392. if Count=0 then
  6393. begin
  6394. EditorDialog(edSearchFailed,nil);
  6395. exit;
  6396. end;
  6397. if SForward then
  6398. DY:=1
  6399. else
  6400. DY:=-1;
  6401. DX:=DY;
  6402. if FindStr<>'' then
  6403. PushInfo('Looking for "'+FindStr+'"');
  6404. if (FindFlags and ffmScope)=ffGlobal then
  6405. begin
  6406. AreaStart.X:=0;
  6407. AreaStart.Y:=0;
  6408. AreaEnd.X:=length(GetDisplayText(Count-1));
  6409. AreaEnd.Y:=Count-1;
  6410. end
  6411. else
  6412. begin
  6413. AreaStart:=SelStart;
  6414. AreaEnd:=SelEnd;
  6415. end;
  6416. { set a y value being inside the areal }
  6417. Y:=Min(CurPos.Y,Count-1);
  6418. if sForward then
  6419. X:=CurPos.X-1
  6420. else
  6421. { if you change this, pleas check that repeated backward searching for single chars still works
  6422. and that data is still found if searching starts outside the current line }
  6423. X:=Min(CurPos.X,length(GetDisplayText(Y)));
  6424. if SearchRunCount=1 then
  6425. if (FindFlags and ffmOrigin)=ffEntireScope then
  6426. if SForward then
  6427. begin
  6428. X:=AreaStart.X-1;
  6429. Y:=AreaStart.Y;
  6430. end
  6431. else
  6432. begin
  6433. X:=AreaEnd.X+1;
  6434. Y:=AreaEnd.Y;
  6435. end;
  6436. if FindFlags and ffCaseSensitive<>0 then
  6437. begin
  6438. if SForward then
  6439. BMFMakeTable(FindStr,bt)
  6440. else
  6441. BMBMakeTable(FindStr,bt);
  6442. end
  6443. else
  6444. begin
  6445. IFindStr:=upcase(FindStr);
  6446. if SForward then
  6447. BMFMakeTable(IFindStr,bt)
  6448. else
  6449. BMBMakeTable(IFindStr,bt);
  6450. end;
  6451. inc(X,DX);
  6452. CanExit:=false;
  6453. if not DoReplace or (not Confirm and (Owner<>nil)) then
  6454. Owner^.Lock;
  6455. if InArea(X,Y) then
  6456. repeat
  6457. CurDY:=DY;
  6458. S:=GetDisplayText(Y);
  6459. if X>length(S)-1 then
  6460. X:=length(S)-1;
  6461. {$ifdef TEST_REGEXP}
  6462. if UseRegExp then
  6463. begin
  6464. getmem(findstrpchar,length(Copy(S,X+1,Length(S)))+1);
  6465. strpcopy(findstrpchar,Copy(S,X+1,Length(S)));
  6466. { If start of line is required do check other positions PM }
  6467. if (FindStr[1]='^') and (X<>0) then
  6468. Found:=false
  6469. else
  6470. Found:=RegExprPos(RegExpEngine,findstrpchar,regexpindex,regexplen);
  6471. strdispose(findstrpchar);
  6472. P:=regexpindex+X+1;
  6473. end
  6474. else
  6475. {$endif TEST_REGEXP}
  6476. begin
  6477. P:=ContainsText(FindStr,S,X+1);
  6478. Found:=P<>0;
  6479. end;
  6480. if Found then
  6481. begin
  6482. A.X:=P-1;
  6483. A.Y:=Y;
  6484. B.Y:=Y;
  6485. {$ifdef TEST_REGEXP}
  6486. if UseRegExp then
  6487. B.X:=A.X+regexplen
  6488. else
  6489. {$endif TEST_REGEXP}
  6490. B.X:=A.X+length(FindStr);
  6491. end;
  6492. Found:=Found and InArea(A.X,A.Y);
  6493. if Found and ((FindFlags and ffWholeWordsOnly)<>0) then
  6494. begin
  6495. LeftOK:=(A.X<=0) or (not( (S[A.X] in AlphaChars+NumberChars) ));
  6496. RightOK:=(B.X>=length(S)) or (not( (S[B.X+1] in AlphaChars+NumberChars) ));
  6497. Found:=LeftOK and RightOK;
  6498. if not Found then
  6499. begin
  6500. CurDY:=0;
  6501. If SForward then
  6502. begin
  6503. X:=B.X+1;
  6504. if X>length(S) then
  6505. CurDY:=DY;
  6506. end
  6507. else
  6508. begin
  6509. X:=A.X-1;
  6510. if X<0 then
  6511. CurDY:=DY;
  6512. end;
  6513. end;
  6514. end;
  6515. if Found then
  6516. begin
  6517. Inc(FoundCount);
  6518. Lock;
  6519. if SForward then
  6520. SetCurPtr(B.X,B.Y)
  6521. else
  6522. SetCurPtr(A.X,A.Y);
  6523. TrackCursor(do_centre);
  6524. SetHighlight(A,B);
  6525. UnLock;
  6526. CurDY:=0;
  6527. if not DoReplace then
  6528. begin
  6529. CanExit:=true;
  6530. If SForward then
  6531. begin
  6532. X:=B.X;
  6533. Y:=B.Y;
  6534. end
  6535. else
  6536. begin
  6537. X:=A.X;
  6538. Y:=A.Y;
  6539. end;
  6540. end
  6541. else
  6542. begin
  6543. if not confirm then
  6544. CanReplace:=true
  6545. else
  6546. begin
  6547. Re:=EditorDialog(edReplacePrompt,@CurPos);
  6548. case Re of
  6549. cmYes :
  6550. CanReplace:=true;
  6551. cmNo :
  6552. CanReplace:=false;
  6553. else {cmCancel}
  6554. begin
  6555. CanReplace:=false;
  6556. CanExit:=true;
  6557. end;
  6558. end;
  6559. end;
  6560. if CanReplace then
  6561. begin
  6562. Lock;
  6563. { don't use SetInsertMode here because it changes the cursor shape }
  6564. overwriting:=(GetFlags and efInsertMode)=0;
  6565. SetFlags(GetFlags or efInsertMode);
  6566. SetSelection(A,B);
  6567. DelSelect;
  6568. InsertText(ReplaceStr);
  6569. if SForward then
  6570. begin
  6571. X:=CurPos.X;
  6572. Y:=CurPos.Y;
  6573. end
  6574. else
  6575. begin
  6576. X:=A.X;
  6577. Y:=A.Y;
  6578. end;
  6579. if overwriting then
  6580. SetFlags(GetFlags and (not efInsertMode));
  6581. UnLock;
  6582. end
  6583. else
  6584. begin
  6585. If SForward then
  6586. begin
  6587. X:=B.X;
  6588. Y:=B.Y;
  6589. end
  6590. else
  6591. begin
  6592. X:=A.X;
  6593. Y:=A.Y;
  6594. end;
  6595. end;
  6596. if (DoReplaceAll=false) then
  6597. CanExit:=true;
  6598. end;
  6599. end;
  6600. if (CanExit=false) and (CurDY<>0) then
  6601. begin
  6602. inc(Y,CurDY);
  6603. if SForward then
  6604. X:=0
  6605. else
  6606. X:=254;
  6607. CanExit:=((Y>=Count) and sForward) or (Y<0);
  6608. end;
  6609. if not CanExit then
  6610. CanExit:=(not InArea(X,Y)) and sForward;
  6611. until CanExit;
  6612. if (FoundCount=0) or (DoReplace) then
  6613. SetHighlight(CurPos,CurPos);
  6614. if (DoReplace=false) or ((Confirm=false) and (Owner<>nil)) then
  6615. Owner^.UnLock;
  6616. {if (DoReplace=false) or (Confirm=false) then
  6617. UnLock;}
  6618. if (FoundCount=0) then
  6619. EditorDialog(edSearchFailed,nil);
  6620. if FindStr<>'' then
  6621. PopInfo;
  6622. {$ifdef TEST_REGEXP}
  6623. if UseRegExp then
  6624. DestroyRegExprEngine(RegExpEngine);
  6625. {$endif TEST_REGEXP}
  6626. if (FindFlags and ffmScope)=ffSelectedText then
  6627. { restore selection PM }
  6628. begin
  6629. SetSelection(AreaStart,AreaEnd);
  6630. end;
  6631. end;
  6632. function TCustomCodeEditor.GetAutoBrackets: boolean;
  6633. begin
  6634. GetAutoBrackets:=(GetFlags and efAutoBrackets)<>0;
  6635. end;
  6636. procedure TCustomCodeEditor.SetAutoBrackets(AutoBrackets: boolean);
  6637. begin
  6638. if AutoBrackets then
  6639. SetFlags(GetFlags or efAutoBrackets)
  6640. else
  6641. SetFlags(GetFlags and (not efAutoBrackets));
  6642. end;
  6643. function TCustomCodeEditor.GetInsertMode: boolean;
  6644. begin
  6645. GetInsertMode:=(GetFlags and efInsertMode)<>0;
  6646. end;
  6647. procedure TCustomCodeEditor.SetInsertMode(InsertMode: boolean);
  6648. begin
  6649. if InsertMode then
  6650. SetFlags(GetFlags or efInsertMode)
  6651. else
  6652. SetFlags(GetFlags and (not efInsertMode));
  6653. DrawCursor;
  6654. end;
  6655. { there is a problem with ShiftDel here
  6656. because GetShitState tells to extend the
  6657. selection which gives wrong results (PM) }
  6658. function TCustomCodeEditor.ShouldExtend: boolean;
  6659. var ShiftInEvent: boolean;
  6660. begin
  6661. ShiftInEvent:=false;
  6662. if Assigned(CurEvent) then
  6663. if CurEvent^.What=evKeyDown then
  6664. ShiftInEvent:=((CurEvent^.KeyShift and kbShift)<>0);
  6665. ShouldExtend:=ShiftInEvent and
  6666. not DontConsiderShiftState;
  6667. end;
  6668. procedure TCustomCodeEditor.SetCurPtr(X,Y: sw_integer);
  6669. var OldPos{,OldSEnd,OldSStart}: TPoint;
  6670. Extended: boolean;
  6671. F: PFold;
  6672. begin
  6673. Lock;
  6674. X:=Max(0,Min(MaxLineLength+1,X));
  6675. Y:=Max(0,Min(GetLineCount-1,Y));
  6676. OldPos:=CurPos;
  6677. { OldSEnd:=SelEnd;
  6678. OldSStart:=SelStart;}
  6679. CurPos.X:=X;
  6680. CurPos.Y:=Y;
  6681. TrackCursor(do_not_centre);
  6682. if not IsLineVisible(CurPos.Y) then
  6683. begin
  6684. F:=GetLineFold(CurPos.Y);
  6685. if Assigned(F) then
  6686. F^.Collapse(false);
  6687. end;
  6688. if not NoSelect and ShouldExtend then
  6689. begin
  6690. CheckSels;
  6691. Extended:=false;
  6692. if PointOfs(OldPos)=PointOfs(SelStart) then
  6693. begin
  6694. SetSelection(CurPos,SelEnd);
  6695. Extended:=true;
  6696. end;
  6697. CheckSels;
  6698. if Extended=false then
  6699. if PointOfs(OldPos)=PointOfs(SelEnd) then
  6700. begin
  6701. if not ValidBlock then
  6702. SetSelection(CurPos,CurPos);
  6703. SetSelection(SelStart,CurPos); Extended:=true;
  6704. end;
  6705. CheckSels;
  6706. if not Extended then
  6707. if PointOfs(OldPos)<=PointOfs(CurPos) then
  6708. begin
  6709. SetSelection(OldPos,CurPos);
  6710. Extended:=true;
  6711. end
  6712. else
  6713. begin
  6714. SetSelection(CurPos,OldPos);
  6715. Extended:=true;
  6716. end;
  6717. DrawView;
  6718. end
  6719. else if not IsFlagSet(efPersistentBlocks) then
  6720. begin
  6721. HideSelect;
  6722. DrawView;
  6723. end;
  6724. { if PointOfs(SelStart)=PointOfs(SelEnd) then
  6725. SetSelection(CurPos,CurPos);}
  6726. if (GetFlags and (efHighlightColumn+efHighlightRow))<>0 then
  6727. DrawView;
  6728. if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) and
  6729. ((Highlight.A.X<>HighLight.B.X) or (Highlight.A.Y<>HighLight.B.Y)) then
  6730. HideHighlight;
  6731. if (OldPos.Y<>CurPos.Y) and (0<=OldPos.Y) and (OldPos.Y<GetLineCount) then
  6732. SetLineText(OldPos.Y,RTrim(GetLineText(OldPos.Y),not IsFlagSet(efUseTabCharacters)));
  6733. if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) and (GetErrorMessage<>'') then
  6734. SetErrorMessage('');
  6735. { if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) and (HighlightRow<>-1) then
  6736. SetHighlightRow(-1);}
  6737. if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) then
  6738. AddAction(eaMoveCursor,OldPos,CurPos,'',GetFlags);
  6739. if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) then
  6740. PositionChanged;{UpdateIndicator;}
  6741. UnLock;
  6742. end;
  6743. procedure TCustomCodeEditor.CheckSels;
  6744. begin
  6745. if (SelStart.Y>SelEnd.Y) or
  6746. ( (SelStart.Y=SelEnd.Y) and (SelStart.X>SelEnd.X) ) then
  6747. SetSelection(SelEnd,SelStart);
  6748. end;
  6749. procedure TCustomCodeEditor.CodeCompleteApply;
  6750. var S: string;
  6751. FragLen,
  6752. I: integer;
  6753. begin
  6754. Lock;
  6755. { here should be some kind or "mark" or "break" inserted in the Undo
  6756. information, so activating it "undoes" only the completition first and
  6757. doesn't delete the complete word at once... - Gabor }
  6758. FragLen:=Length(GetCodeCompleteFrag);
  6759. S:=GetCodeCompleteWord;
  6760. for I:=FragLen+1 to length(S) do
  6761. AddChar(S[I]);
  6762. UnLock;
  6763. SetCompleteState(csInactive);
  6764. end;
  6765. procedure TCustomCodeEditor.CodeCompleteCancel;
  6766. begin
  6767. SetCompleteState(csDenied);
  6768. end;
  6769. procedure TCustomCodeEditor.CodeCompleteCheck;
  6770. var Line: string;
  6771. X: sw_integer;
  6772. CurWord,NewWord: string;
  6773. begin
  6774. SetCodeCompleteFrag('');
  6775. if (not IsFlagSet(efCodeComplete)) or (IsReadOnly=true) then Exit;
  6776. Lock;
  6777. Line:=GetDisplayText(CurPos.Y);
  6778. X:=CurPos.X; CurWord:='';
  6779. if X<=length(Line) then
  6780. while (X>0) and (Line[X] in (NumberChars+AlphaChars)) do
  6781. begin
  6782. CurWord:=Line[X]+CurWord;
  6783. Dec(X);
  6784. end;
  6785. if (length(CurWord)>=CodeCompleteMinLen) and CompleteCodeWord(CurWord,NewWord) then
  6786. begin
  6787. SetCodeCompleteFrag(CurWord);
  6788. SetCodeCompleteWord(NewWord);
  6789. end
  6790. else
  6791. ClearCodeCompleteWord;
  6792. UnLock;
  6793. end;
  6794. function TCustomCodeEditor.GetCodeCompleteFrag: string;
  6795. begin
  6796. { Abstract }
  6797. GetCodeCompleteFrag:='';
  6798. end;
  6799. procedure TCustomCodeEditor.SetCodeCompleteFrag(const S: string);
  6800. begin
  6801. { Abstract }
  6802. end;
  6803. procedure TCustomCodeEditor.DrawLines(FirstLine: sw_integer);
  6804. begin
  6805. if FirstLine>=(Delta.Y+Size.Y) then Exit; { falls outside of the screen }
  6806. DrawView;
  6807. end;
  6808. procedure TCustomCodeEditor.HideHighlight;
  6809. begin
  6810. SetHighlight(CurPos,CurPos);
  6811. end;
  6812. function TCustomCodeEditor.InSelectionArea:boolean; {CurPos in selection area}
  6813. begin
  6814. InSelectionArea:=false;
  6815. if ((SelStart.X<>SelEnd.X) or (SelStart.Y<>SelEnd.Y)) then {there is selection}
  6816. begin
  6817. if (SelStart.Y = SelEnd.Y) and (CurPos.X>=min(SelStart.X,SelEnd.X)) and (CurPos.X<=max(SelStart.X,SelEnd.X)) then
  6818. InSelectionArea:=true {select in one line}
  6819. else if (CurPos.Y>min(SelStart.Y,SelEnd.Y)) and (CurPos.Y<max(SelStart.Y,SelEnd.Y)) then
  6820. InSelectionArea:=true {between first and last selected line}
  6821. else if (SelStart.Y < SelEnd.Y) and ( ((SelStart.Y=CurPos.Y) and (SelStart.X<=CurPos.X)) or ((SelEnd.Y=CurPos.Y) and (SelEnd.X>=CurPos.X))) then
  6822. InSelectionArea:=true {in first line or last line}
  6823. else if (SelStart.Y > SelEnd.Y) and ( ((SelStart.Y=CurPos.Y) and (SelStart.X>=CurPos.X)) or ((SelEnd.Y=CurPos.Y) and (SelEnd.X<=CurPos.X))) then
  6824. InSelectionArea:=true; {in first line or last line (selection Start and End revers)}
  6825. end;
  6826. end;
  6827. procedure TCustomCodeEditor.GetSelectionArea(var StartP,EndP: TPoint);
  6828. begin
  6829. StartP:=SelStart; EndP:=SelEnd;
  6830. if EndP.X=0 then
  6831. begin
  6832. Dec(EndP.Y);
  6833. EndP.X:=length(GetDisplayText(EndP.Y))-1;
  6834. end
  6835. else
  6836. Dec(EndP.X);
  6837. end;
  6838. function TCustomCodeEditor.ValidBlock: boolean;
  6839. begin
  6840. ValidBlock:=(SelStart.X<>SelEnd.X) or (SelStart.Y<>SelEnd.Y);
  6841. end;
  6842. procedure TCustomCodeEditor.SetSelection(A, B: TPoint);
  6843. var WV: boolean;
  6844. OS,OE: TPoint;
  6845. begin
  6846. WV:=ValidBlock;
  6847. OS:=SelStart; OE:=SelEnd;
  6848. SelStart:=A; SelEnd:=B;
  6849. if (WV=false) and (ValidBlock=false) then { do nothing } else
  6850. if (OS.X<>SelStart.X) or (OS.Y<>SelStart.Y) or
  6851. (OE.X<>SelEnd.X) or (OE.Y<>SelEnd.Y) then
  6852. SelectionChanged;
  6853. end;
  6854. procedure TCustomCodeEditor.SetHighlight(A, B: TPoint);
  6855. begin
  6856. Highlight.A:=A; Highlight.B:=B;
  6857. HighlightChanged;
  6858. end;
  6859. {procedure TCustomCodeEditor.SetHighlightRow(Row: sw_integer);
  6860. begin
  6861. HighlightRow:=Row;
  6862. DrawView;
  6863. end;}
  6864. {procedure TCodeEditor.SetDebuggerRow(Row: sw_integer);
  6865. begin
  6866. DebuggerRow:=Row;
  6867. DrawView;
  6868. end;}
  6869. procedure TCustomCodeEditor.SelectAll(Enable: boolean);
  6870. var A,B: TPoint;
  6871. begin
  6872. if (Enable=false) or (GetLineCount=0) then
  6873. begin A:=CurPos; B:=CurPos end
  6874. else
  6875. begin
  6876. A.X:=0; A.Y:=0;
  6877. { B.Y:=GetLineCount-1;
  6878. B.X:=length(GetLineText(B.Y));}
  6879. B.Y:=GetLineCount; B.X:=0;
  6880. end;
  6881. SetSelection(A,B);
  6882. DrawView;
  6883. end;
  6884. procedure TCustomCodeEditor.CommentSel;
  6885. var
  6886. ey,i : Sw_Integer;
  6887. S,Ind : Sw_AString;
  6888. Pos : Tpoint;
  6889. WasPersistentBlocks : boolean;
  6890. WhiteLen, k : Sw_Integer;
  6891. LLen : Sw_Integer; { length of longest line }
  6892. begin
  6893. if IsReadOnly then Exit;
  6894. if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
  6895. Lock;
  6896. ey:=SelEnd.Y;
  6897. if SelEnd.X=0 then
  6898. dec(ey);
  6899. S:='';
  6900. { Find shortest white space of beginning of line from all lines
  6901. for simplisity reason Tab is not recognized as white space in this regard }
  6902. LLen:=0;
  6903. WhiteLen:=-1;
  6904. WhiteLen:= WhiteLen shr 1; { logical SHR to get max sw_integer }
  6905. for i:=SelStart.Y to ey do
  6906. begin
  6907. S:=GetDisplayText(i);
  6908. LLen:=Max(LLen,Length(S));
  6909. S:=GetLineText(i);
  6910. LLen:=Max(LLen,Length(S)); {whatever is longer displayed text or actual line text }
  6911. WhiteLen:=Min(WhiteLen,Length(S));
  6912. if WhiteLen = 0 then
  6913. break; {string length is zero, no lower where to go }
  6914. k:=1;
  6915. while (k<=WhiteLen) and (S[k]=' ') do { Tab do not count in }
  6916. inc(k);
  6917. WhiteLen:=k-1;
  6918. if WhiteLen = 0 then
  6919. break; { we have done enough, no white spaces at all }
  6920. end;
  6921. if WhiteLen=(sw_integer(-1) shr 1) then
  6922. WhiteLen:=0; { eee, never can happen, but if ever then we will be safe }
  6923. {$if sizeof(sw_astring)>8}
  6924. if LLen > 252 then { if lines are shortstrings and there is no room to add 2 chars }
  6925. begin
  6926. UnLock;
  6927. MessageBox('Lines too long!', nil, mfOKButton);
  6928. exit;
  6929. end;
  6930. {$endif}
  6931. AddGroupedAction(eaCommentSel);
  6932. WasPersistentBlocks:=IsFlagSet(efPersistentBlocks);
  6933. if not WasPersistentBlocks then
  6934. SetFlags(GetFlags or efPersistentBlocks);
  6935. {selection Start and End move along}
  6936. if SelStart.X>WhiteLen then inc(SelStart.X,2);
  6937. if SelEnd.X>WhiteLen then inc(SelEnd.X,2);
  6938. { put line comment in front of every selected line }
  6939. Ind:='//';
  6940. for i:=SelStart.Y to ey do
  6941. begin
  6942. S:=GetLineText(i);
  6943. S:=copy(S,1,WhiteLen)+Ind+copy(S,WhiteLen+1,Length(S));
  6944. SetLineText(i,S);
  6945. Pos.X:=WhiteLen;Pos.Y:=i;
  6946. AddAction(eaInsertText,Pos,Pos,Ind,GetFlags);
  6947. end;
  6948. Pos:=CurPos;
  6949. { this removes selection if Shift is pressed as well }
  6950. if (CurPos.X > WhiteLen) and (SelStart.Y<=CurPos.Y) and (CurPos.Y<=ey) then
  6951. SetCurPtr(CurPos.X+2,CurPos.Y);
  6952. {after SetCurPtr return PersistentBlocks as it was before}
  6953. if not WasPersistentBlocks then
  6954. SetFlags(GetFlags and (not longword(efPersistentBlocks)));
  6955. { must be added manually here PM }
  6956. AddAction(eaMoveCursor,Pos,CurPos,'',GetFlags);
  6957. UpdateAttrsRange(SelStart.Y,SelEnd.Y,attrAll);
  6958. DrawLines(CurPos.Y);
  6959. SetModified(true);
  6960. CloseGroupedAction(eaCommentSel);
  6961. UnLock;
  6962. end;
  6963. procedure TCustomCodeEditor.UnCommentSel;
  6964. var
  6965. ey,i : Sw_Integer;
  6966. S,Ind : Sw_AString;
  6967. Pos : Tpoint;
  6968. WasPersistentBlocks : boolean;
  6969. WhiteLen, k : Sw_Integer;
  6970. WasGroupAction : boolean;
  6971. NeedToMoveCursor:boolean;
  6972. begin
  6973. if IsReadOnly then Exit;
  6974. if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
  6975. Lock;
  6976. ey:=SelEnd.Y;
  6977. if SelEnd.X=0 then
  6978. dec(ey);
  6979. WasGroupAction:=false;
  6980. NeedToMoveCursor:=false;
  6981. { remove line comment from beginning of every selected line ( if there is any) }
  6982. Ind:='//';
  6983. for i:=SelStart.Y to ey do
  6984. begin
  6985. S:=GetLineText(i);
  6986. if Length(S)<2 then continue;
  6987. WhiteLen:=0;
  6988. for k:=1 to Length(S)-1 do
  6989. if not (S[k] in [' ',#9]) then
  6990. break; { white space is over }
  6991. if (S[k]<>'/') or (S[k+1]<>'/') then continue; { continue if comment not found }
  6992. WhiteLen:=k-1;
  6993. if not WasGroupAction then
  6994. begin
  6995. {add group action only if there is at least one action
  6996. because empty group action throw segment fault when do Undo }
  6997. WasGroupAction:=true;
  6998. AddGroupedAction(eaUnCommentSel);
  6999. end;
  7000. S:=copy(S,1,WhiteLen)+copy(S,WhiteLen+1+2,Length(S)); { delete line comment string '//' }
  7001. SetLineText(i,S);
  7002. Pos.X:=WhiteLen;Pos.Y:=i;
  7003. AddAction(eaDeleteText,Pos,Pos,Ind,GetFlags);
  7004. {selection Start and End move along}
  7005. if i=SelStart.Y then
  7006. if (SelStart.X>1) and (SelStart.X>WhiteLen+1) then dec(SelStart.X,2);
  7007. if i=SelEnd.Y then
  7008. if (SelEnd.X>1) and (SelEnd.X>WhiteLen+1) then dec(SelEnd.X,2);
  7009. if i=CurPos.Y then
  7010. if (CurPos.X>1) and (CurPos.X>WhiteLen+1) then NeedToMoveCursor:=true;
  7011. end;
  7012. if WasGroupAction then
  7013. begin
  7014. WasPersistentBlocks:=IsFlagSet(efPersistentBlocks);
  7015. if not WasPersistentBlocks then
  7016. SetFlags(GetFlags or efPersistentBlocks);
  7017. Pos:=CurPos;
  7018. { this removes selection if Shift is pressed as well }
  7019. if NeedToMoveCursor then
  7020. SetCurPtr(CurPos.X-2,CurPos.Y);
  7021. {after SetCurPtr return PersistentBlocks as it was before}
  7022. if not WasPersistentBlocks then
  7023. SetFlags(GetFlags and (not longword(efPersistentBlocks)));
  7024. { must be added manually here PM }
  7025. AddAction(eaMoveCursor,Pos,CurPos,'',GetFlags);
  7026. UpdateAttrsRange(SelStart.Y,SelEnd.Y,attrAll);
  7027. DrawLines(CurPos.Y);
  7028. SetModified(true);
  7029. CloseGroupedAction(eaUnCommentSel);
  7030. end;
  7031. UnLock;
  7032. end;
  7033. procedure TCustomCodeEditor.SelectionChanged;
  7034. var Enable,CanPaste: boolean;
  7035. begin
  7036. if GetLineCount=0 then
  7037. begin
  7038. SelStart.X:=0; SelStart.Y:=0; SelEnd:=SelStart;
  7039. end
  7040. else
  7041. if SelEnd.Y>GetLineCount-1 then
  7042. if (SelEnd.Y<>GetLineCount) or (SelEnd.X<>0) then
  7043. begin
  7044. SelEnd.Y:=GetLineCount-1;
  7045. SelEnd.X:=length(GetDisplayText(SelEnd.Y));
  7046. end;
  7047. { we change the CurCommandSet, but only if we are top view }
  7048. if ((State and sfFocused)<>0) then
  7049. begin
  7050. Enable:=((SelStart.X<>SelEnd.X) or (SelStart.Y<>SelEnd.Y)) and (Clipboard<>nil);
  7051. SetCmdState(ToClipCmds,Enable and (Clipboard<>@Self));
  7052. SetCmdState(NulClipCmds,Enable);
  7053. CanPaste:=(Clipboard<>nil) and ((Clipboard^.SelStart.X<>Clipboard^.SelEnd.X) or
  7054. (Clipboard^.SelStart.Y<>Clipboard^.SelEnd.Y));
  7055. SetCmdState(FromClipCmds,CanPaste and (Clipboard<>@Self));
  7056. SetCmdState(UndoCmd,(GetUndoActionCount>0));
  7057. SetCmdState(RedoCmd,(GetRedoActionCount>0));
  7058. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  7059. end;
  7060. DrawView;
  7061. end;
  7062. procedure TCustomCodeEditor.HighlightChanged;
  7063. begin
  7064. DrawView;
  7065. end;
  7066. procedure TCustomCodeEditor.SetState(AState: Word; Enable: Boolean);
  7067. procedure ShowSBar(SBar: PScrollBar);
  7068. begin
  7069. if Assigned(SBar) and (SBar^.GetState(sfVisible)=false) then
  7070. SBar^.Show;
  7071. end;
  7072. begin
  7073. inherited SetState(AState,Enable);
  7074. if AlwaysShowScrollBars then
  7075. begin
  7076. ShowSBar(HScrollBar);
  7077. ShowSBar(VScrollBar);
  7078. end;
  7079. if (AState and (sfActive+sfSelected+sfFocused))<>0 then
  7080. begin
  7081. SelectionChanged;
  7082. if ((State and sfFocused)=0) and (GetCompleteState=csOffering) then
  7083. ClearCodeCompleteWord;
  7084. end;
  7085. end;
  7086. function TCustomCodeEditor.GetPalette: PPalette;
  7087. const P: string[length(CEditor)] = CEditor;
  7088. begin
  7089. GetPalette:=@P;
  7090. end;
  7091. function TCustomCodeEditorCore.LoadFromStream(Editor: PCustomCodeEditor; Stream: PFastBufStream): boolean;
  7092. var S: sw_AString;
  7093. AllLinesComplete,LineComplete,hasCR,OK: boolean;
  7094. begin
  7095. DeleteAllLines;
  7096. ChangedLine:=-1;
  7097. AllLinesComplete:=true;
  7098. OK:=(Stream^.Status=stOK);
  7099. if eofstream(Stream) then
  7100. AddLine('')
  7101. else
  7102. begin
  7103. while OK and (eofstream(Stream)=false) and (GetLineCount<MaxLineCount) do
  7104. begin
  7105. if not UseOldBufStreamMethod then
  7106. Stream^.Readline(S,LineComplete,hasCR)
  7107. else
  7108. ReadlnFromStream(Stream,S,LineComplete,hasCR);
  7109. AllLinesComplete:=AllLinesComplete and LineComplete;
  7110. OK:=OK and (Stream^.Status=stOK);
  7111. if OK then AddLine(S);
  7112. if not LineComplete and (ChangedLine=-1) then
  7113. ChangedLine:=GetLineCount;
  7114. end;
  7115. { Do not remove the final newline if it exists PM }
  7116. if hasCR then
  7117. AddLine('');
  7118. end;
  7119. LimitsChanged;
  7120. if not AllLinesComplete then
  7121. SetModified(true);
  7122. if (GetLineCount=MaxLineCount) and not eofstream(stream) then
  7123. EditorDialog(edTooManyLines,nil);
  7124. LoadFromStream:=OK;
  7125. end;
  7126. function TCustomCodeEditorCore.SaveAreaToStream(Editor: PCustomCodeEditor; Stream: PStream; StartP,EndP: TPoint): boolean;
  7127. var S: sw_astring;
  7128. OK: boolean;
  7129. Line: Sw_integer;
  7130. begin
  7131. if EndP.X=0 then
  7132. begin
  7133. if EndP.Y>0 then
  7134. begin
  7135. EndP.X:=length(GetDisplayText(EndP.Y));
  7136. end
  7137. else
  7138. EndP.X:=0;
  7139. end
  7140. else
  7141. Dec(EndP.X);
  7142. OK:=(Stream^.Status=stOK); Line:=StartP.Y;
  7143. while OK and (Line<=EndP.Y) and (Line<GetLineCount) do
  7144. begin
  7145. S:=GetLineText(Line);
  7146. { Remove all traling spaces PM }
  7147. if not Editor^.IsFlagSet(efKeepTrailingSpaces) then
  7148. s:=RTrim(S,False); // removes trailing #0 too
  7149. { if FlagSet(efUseTabCharacters) then
  7150. S:=CompressUsingTabs(S,TabSize);
  7151. }
  7152. if Line=EndP.Y then S:=copy(S,1,LinePosToCharIdx(Line,EndP.X));
  7153. if Line=StartP.Y then S:=copy(S,LinePosToCharIdx(Line,StartP.X),Length(S));
  7154. Stream^.Write(S[1],length(S));
  7155. if Line<EndP.Y then
  7156. Stream^.Write(EOL[1],length(EOL));
  7157. Inc(Line);
  7158. OK:=OK and (Stream^.Status=stOK);
  7159. end;
  7160. SaveAreaToStream:=OK;
  7161. end;
  7162. constructor TEditorAction.init(act:byte; StartP,EndP:TPoint;Txt:Sw_AString;AFlags : longint);
  7163. begin
  7164. Action:=act;
  7165. StartPos:=StartP;
  7166. EndPos:=EndP;
  7167. SetText(Txt);
  7168. ActionCount:=0;
  7169. Flags:=AFlags;
  7170. TimeStamp:=Now;
  7171. IsGrouped:=false;
  7172. end;
  7173. constructor TEditorAction.init_group(act:byte);
  7174. begin
  7175. Action:=act;
  7176. ActionCount:=0;
  7177. Flags:=0;
  7178. IsGrouped:=true;
  7179. end;
  7180. function TEditorAction.Is_grouped_action : boolean;
  7181. begin
  7182. Is_grouped_action:=IsGrouped;
  7183. end;
  7184. function TEditorAction.GetText : sw_astring;
  7185. var st : string;
  7186. begin
  7187. {$if sizeof(sw_astring)>8}
  7188. GetText:=GetStr(Text);
  7189. {$else}
  7190. GetText:=Text;
  7191. {$endif}
  7192. end;
  7193. procedure TEditorAction.SetText(AText : sw_astring);
  7194. var st : string;
  7195. begin
  7196. {$if sizeof(sw_astring)>8}
  7197. SetStr(Text,AText);
  7198. {$else}
  7199. Text:=AText;
  7200. {$endif}
  7201. end;
  7202. destructor TEditorAction.done;
  7203. begin
  7204. {$if sizeof(sw_astring)>8}
  7205. if assigned(Text) then
  7206. DisposeStr(Text);
  7207. Text:=nil;
  7208. {$else}
  7209. Text:='';
  7210. {$endif}
  7211. inherited done;
  7212. end;
  7213. function TEditorActionCollection.At(Idx : sw_integer) : PEditorAction;
  7214. begin
  7215. At:=PEditorAction(Inherited At(Idx));
  7216. end;
  7217. procedure TEditorInputLine.HandleEvent(var Event : TEvent);
  7218. var
  7219. s : sw_astring;
  7220. st : string; {need to be shortstring for InputLine}
  7221. i : longint;
  7222. begin
  7223. If (Event.What=evKeyDown) then
  7224. begin
  7225. if (Event.KeyCode=kbRight) and
  7226. (CurPos = Length(Data^)) and
  7227. Assigned(FindReplaceEditor) then
  7228. Begin
  7229. s:=FindReplaceEditor^.GetDisplayText(FindReplaceEditor^.CurPos.Y);
  7230. i:=Min(FindReplaceEditor^.CurPos.X+1,length(s));
  7231. {finds beginning of word}
  7232. if i>0 then
  7233. while s[i] in ['a'..'z','A'..'Z','0'..'9','_'] do
  7234. begin
  7235. dec(i);
  7236. if i=0 then break;
  7237. end;
  7238. inc(i);
  7239. {step out of white space}
  7240. if i<length(s) then
  7241. while (s[i] in [' ']) do
  7242. begin
  7243. inc(i);
  7244. if i=length(s) then break;
  7245. end;
  7246. st:=Copy(s,i-length(Data^),length(s)-(i-length(Data^))+1);
  7247. if length(Data^)=0 then
  7248. i:=1 {if input line is empty then start from first character of word if any}
  7249. else
  7250. i:=pos(Data^,st);
  7251. if (i>0) and (length(st)>=i+length(Data^)) then
  7252. begin
  7253. st:=Data^+st[i+length(Data^)];
  7254. If not assigned(validator) or
  7255. Validator^.IsValidInput(st,False) then
  7256. Begin
  7257. Event.CharCode:=st[length(st)];
  7258. Event.Scancode:=0;
  7259. Inherited HandleEvent(Event);
  7260. End;
  7261. end;
  7262. ClearEvent(Event);
  7263. End
  7264. else if ((Event.KeyCode=kbShiftIns) or (Event.KeyCode=paste_key)) and
  7265. Assigned(Clipboard) and (Clipboard^.ValidBlock) then
  7266. { paste from clipboard }
  7267. begin
  7268. i:=Clipboard^.SelStart.Y;
  7269. s:=Clipboard^.GetDisplayText(i);
  7270. i:=Clipboard^.SelStart.X;
  7271. if i>0 then
  7272. s:=copy(s,i+1,length(s));
  7273. if (Clipboard^.SelStart.Y=Clipboard^.SelEnd.Y) then
  7274. begin
  7275. i:=Clipboard^.SelEnd.X-i;
  7276. s:=copy(s,1,i);
  7277. end;
  7278. for i:=1 to length(s) do
  7279. begin
  7280. st:=Data^+s[i];
  7281. If not assigned(validator) or
  7282. Validator^.IsValidInput(st,False) then
  7283. Begin
  7284. Event.What:=evKeyDown;
  7285. Event.CharCode:=s[i];
  7286. Event.Scancode:=0;
  7287. Inherited HandleEvent(Event);
  7288. End;
  7289. end;
  7290. ClearEvent(Event);
  7291. end
  7292. else if ((Event.KeyCode=kbCtrlIns) or (Event.KeyCode=copy_key)) and
  7293. Assigned(Clipboard) then
  7294. { Copy to clipboard }
  7295. begin
  7296. s:=GetStr(Data);
  7297. s:=copy(s,selstart+1,selend-selstart);
  7298. Clipboard^.SelStart:=Clipboard^.CurPos;
  7299. Clipboard^.InsertText(s);
  7300. Clipboard^.SelEnd:=Clipboard^.CurPos;
  7301. ClearEvent(Event);
  7302. end
  7303. else if ((Event.KeyCode=kbShiftDel) or (Event.KeyCode=cut_key)) and
  7304. Assigned(Clipboard) then
  7305. { Cut to clipboard }
  7306. begin
  7307. s:=GetStr(Data);
  7308. s:=copy(s,selstart+1,selend-selstart);
  7309. Clipboard^.SelStart:=Clipboard^.CurPos;
  7310. Clipboard^.InsertText(s);
  7311. Clipboard^.SelEnd:=Clipboard^.CurPos;
  7312. { now remove the selected part }
  7313. Event.keyCode:=kbDel;
  7314. inherited HandleEvent(Event);
  7315. ClearEvent(Event);
  7316. end
  7317. else if ((Event.KeyCode=kbCtrlDel)) then
  7318. { Cut & discard }
  7319. begin
  7320. { now remove the selected part }
  7321. Event.keyCode:=kbDel;
  7322. inherited HandleEvent(Event);
  7323. ClearEvent(Event);
  7324. end
  7325. else
  7326. Inherited HandleEvent(Event);
  7327. End
  7328. else
  7329. Inherited HandleEvent(Event);
  7330. st:=getstr(data);
  7331. Message(Owner,evBroadCast,cmInputLineLen,pointer(Length(st)));
  7332. end;
  7333. constructor TFPFileInputLine.Init(var Bounds: TRect; AMaxLen: Sw_Integer);
  7334. begin
  7335. inherited Init(Bounds, AMaxLen);
  7336. end;
  7337. procedure TFPFileInputLine.HandleEvent(var Event: TEvent);
  7338. var s : sw_astring;
  7339. i : sw_integer;
  7340. st: string;
  7341. begin
  7342. If (Event.What=evKeyDown) then
  7343. begin
  7344. if ((Event.KeyCode=kbShiftIns) or (Event.KeyCode=paste_key)) and
  7345. Assigned(weditor.Clipboard) and (weditor.Clipboard^.ValidBlock) then
  7346. { paste from clipboard }
  7347. begin
  7348. i:=Clipboard^.SelStart.Y;
  7349. s:=Clipboard^.GetDisplayText(i);
  7350. i:=Clipboard^.SelStart.X;
  7351. if i>0 then
  7352. s:=copy(s,i+1,length(s));
  7353. if (Clipboard^.SelStart.Y=Clipboard^.SelEnd.Y) then
  7354. begin
  7355. i:=Clipboard^.SelEnd.X-i;
  7356. s:=copy(s,1,i);
  7357. end;
  7358. for i:=1 to length(s) do
  7359. begin
  7360. st:=Data^+s[i];
  7361. If not assigned(validator) or
  7362. Validator^.IsValidInput(st,False) then
  7363. Begin
  7364. Event.What:=evKeyDown;
  7365. Event.CharCode:=s[i];
  7366. Event.Scancode:=0;
  7367. Inherited HandleEvent(Event);
  7368. End;
  7369. end;
  7370. ClearEvent(Event);
  7371. end
  7372. else if ((Event.KeyCode=kbCtrlIns) or (Event.KeyCode=copy_key)) and
  7373. Assigned(Clipboard) then
  7374. { Copy to clipboard }
  7375. begin
  7376. s:=GetStr(Data);
  7377. s:=copy(s,selstart+1,selend-selstart);
  7378. Clipboard^.SelStart:=Clipboard^.CurPos;
  7379. Clipboard^.InsertText(s);
  7380. Clipboard^.SelEnd:=Clipboard^.CurPos;
  7381. ClearEvent(Event);
  7382. end
  7383. else if ((Event.KeyCode=kbShiftDel) or (Event.KeyCode=cut_key)) and
  7384. Assigned(Clipboard) then
  7385. { Cut to clipboard }
  7386. begin
  7387. s:=GetStr(Data);
  7388. s:=copy(s,selstart+1,selend-selstart);
  7389. Clipboard^.SelStart:=Clipboard^.CurPos;
  7390. Clipboard^.InsertText(s);
  7391. Clipboard^.SelEnd:=Clipboard^.CurPos;
  7392. { now remove the selected part }
  7393. Event.keyCode:=kbDel;
  7394. inherited HandleEvent(Event);
  7395. ClearEvent(Event);
  7396. end
  7397. else if ((Event.KeyCode=kbCtrlDel)) then
  7398. { Cut & discard }
  7399. begin
  7400. { now remove the selected part }
  7401. Event.keyCode:=kbDel;
  7402. inherited HandleEvent(Event);
  7403. ClearEvent(Event);
  7404. end
  7405. else
  7406. Inherited HandleEvent(Event);
  7407. End
  7408. else
  7409. Inherited HandleEvent(Event);
  7410. //st:=getstr(data);
  7411. //Message(Owner,evBroadCast,cmInputLineLen,pointer(Length(st)));
  7412. end;
  7413. constructor TFPFileDialog.Init(AWildCard: TWildStr; const ATitle,
  7414. InputName: String; AOptions: Word; HistoryId: Byte);
  7415. var R: TRect;
  7416. DInput : PFPFileInputLine;
  7417. Control : PView;
  7418. History : PHistory;
  7419. S : String;
  7420. begin
  7421. inherited init(AWildCard,ATitle,InputName,AOptions,HistoryId);
  7422. FileName^.getData(S);
  7423. R.Assign(3, 3, 31, 4);
  7424. DInput := New(PFPFileInputLine, Init(R, 79{FileNameLen+4}));
  7425. DInput^.SetData(S);
  7426. InsertBefore(DInput,FileName); {insert before to preserv order as it was}
  7427. Delete(FileName);
  7428. Dispose(FileName,done);
  7429. DInput^.GrowMode:=gfGrowHiX;
  7430. FileName:=DInput;
  7431. FileHistory^.Link:=DInput;
  7432. {resize}
  7433. if Desktop^.Size.Y > 26 then
  7434. GrowTo(Size.X,Desktop^.Size.Y-6);
  7435. if Desktop^.Size.X > 70 then
  7436. GrowTo(Min(Desktop^.Size.X-(70-Size.X),102),Size.Y);
  7437. FileList^.NumCols:= Max((FileList^.Size.X-(FileList^.Size.X div 14)) div 14,2);
  7438. { Adjust scrollbar step and page step }
  7439. FileList^.SetRange(FileList^.Range); {set again for scrollbar min max values}
  7440. {set focus on the new input line}
  7441. DInput^.Focus;
  7442. end;
  7443. procedure TSearchHelperDialog.HandleEvent(var Event : TEvent);
  7444. begin
  7445. case Event.What of
  7446. evBroadcast :
  7447. case Event.Command of
  7448. cminputlinelen : begin
  7449. if PtrInt(Event.InfoPtr)=0 then
  7450. okbutton^.DisableCommands([cmok])
  7451. else
  7452. okbutton^.EnableCommands([cmok]);
  7453. clearevent(event);
  7454. end;
  7455. end;
  7456. end;
  7457. inherited HandleEvent(Event);
  7458. end;
  7459. function CreateFindDialog: PDialog;
  7460. var R,R1,R2: TRect;
  7461. D: PSearchHelperDialog;
  7462. IL1: PEditorInputLine;
  7463. Control : PView;
  7464. CB1: PCheckBoxes;
  7465. RB1,RB2,RB3: PRadioButtons;
  7466. but : PButton;
  7467. begin
  7468. R.Assign(0,0,56,15);
  7469. New(D, Init(R, dialog_find));
  7470. with D^ do
  7471. begin
  7472. Options:=Options or ofCentered;
  7473. GetExtent(R); R.Grow(-3,-2);
  7474. R1.Copy(R); R1.B.X:=17; R1.B.Y:=R1.A.Y+1;
  7475. R2.Copy(R); R2.B.X:=R2.B.X-3;R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
  7476. New(IL1, Init(R2, FindStrSize));
  7477. IL1^.Data^:=FindStr;
  7478. Insert(IL1);
  7479. Insert(New(PLabel, Init(R1, label_find_texttofind, IL1)));
  7480. R1.Assign(R2.B.X, R2.A.Y, R2.B.X+3, R2.B.Y);
  7481. Control := New(PHistory, Init(R1, IL1, TextFindId));
  7482. Insert(Control);
  7483. 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;
  7484. R2.Copy(R1); R2.Move(0,1);
  7485. R2.B.Y:=R2.A.Y+{$ifdef TEST_REGEXP}3{$else}2{$endif};
  7486. New(CB1, Init(R2,
  7487. NewSItem(label_find_casesensitive,
  7488. NewSItem(label_find_wholewordsonly,
  7489. {$ifdef TEST_REGEXP}
  7490. NewSItem(label_find_useregexp,
  7491. {$endif TEST_REGEXP}
  7492. nil)))){$ifdef TEST_REGEXP}){$endif TEST_REGEXP};
  7493. Insert(CB1);
  7494. Insert(New(PLabel, Init(R1, label_find_options, CB1)));
  7495. 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;
  7496. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  7497. New(RB1, Init(R2,
  7498. NewSItem(label_find_forward,
  7499. NewSItem(label_find_backward,
  7500. nil))));
  7501. Insert(RB1);
  7502. Insert(New(PLabel, Init(R1, label_find_direction, RB1)));
  7503. 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;
  7504. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  7505. New(RB2, Init(R2,
  7506. NewSItem(label_find_global,
  7507. NewSItem(label_find_selectedtext,
  7508. nil))));
  7509. Insert(RB2);
  7510. Insert(New(PLabel, Init(R1, label_find_scope, RB2)));
  7511. 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;
  7512. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  7513. New(RB3, Init(R2,
  7514. NewSItem(label_find_fromcursor,
  7515. NewSItem(label_find_entirescope,
  7516. nil))));
  7517. Insert(RB3);
  7518. Insert(New(PLabel, Init(R1, label_find_origin, RB3)));
  7519. GetExtent(R); R.Grow(-13,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10;
  7520. Okbutton:=New(PButton, Init(R, btn_OK, cmOK, bfDefault));
  7521. Insert(OkButton);
  7522. R.Move(19,0);
  7523. Insert(New(PButton, Init(R, btn_Cancel, cmCancel, bfNormal)));
  7524. end;
  7525. IL1^.Select;
  7526. CreateFindDialog := D;
  7527. end;
  7528. function CreateReplaceDialog: PDialog;
  7529. var R,R1,R2: TRect;
  7530. D: PDialog;
  7531. Control : PView;
  7532. IL1: PEditorInputLine;
  7533. IL2: PEditorInputLine;
  7534. CB1: PCheckBoxes;
  7535. RB1,RB2,RB3: PRadioButtons;
  7536. begin
  7537. R.Assign(0,0,56,18);
  7538. New(D, Init(R, dialog_replace));
  7539. with D^ do
  7540. begin
  7541. Options:=Options or ofCentered;
  7542. GetExtent(R); R.Grow(-3,-2);
  7543. R1.Copy(R); R1.B.X:=17; R1.B.Y:=R1.A.Y+1;
  7544. R2.Copy(R); R2.B.X:=R2.B.X-3;R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
  7545. New(IL1, Init(R2, FindStrSize));
  7546. IL1^.Data^:=FindStr;
  7547. Insert(IL1);
  7548. Insert(New(PLabel, Init(R1, label_replace_texttofind, IL1)));
  7549. R1.Assign(R2.B.X, R2.A.Y, R2.B.X+3, R2.B.Y);
  7550. Control := New(PHistory, Init(R1, IL1, TextFindId));
  7551. Insert(Control);
  7552. R1.Copy(R); R1.Move(0,2); R1.B.X:=17; R1.B.Y:=R1.A.Y+1;
  7553. R2.Copy(R); R2.Move(0,2);R2.B.X:=R2.B.X-3;
  7554. R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
  7555. New(IL2, Init(R2, FindStrSize));
  7556. IL2^.Data^:=ReplaceStr;
  7557. Insert(IL2);
  7558. Insert(New(PLabel, Init(R1, label_replace_newtext, IL2)));
  7559. R1.Assign(R2.B.X, R2.A.Y, R2.B.X+3, R2.B.Y);
  7560. Control := New(PHistory, Init(R1, IL2, TextReplaceId));
  7561. Insert(Control);
  7562. 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;
  7563. R2.Copy(R1); R2.Move(0,1);
  7564. R2.B.Y:=R2.A.Y+{$ifdef TEST_REGEXP}4{$else}3{$endif};
  7565. New(CB1, Init(R2,
  7566. NewSItem(label_replace_casesensitive,
  7567. NewSItem(label_replace_wholewordsonly,
  7568. NewSItem(label_replace_promptonreplace,
  7569. {$ifdef TEST_REGEXP}
  7570. NewSItem(label_find_useregexp,
  7571. {$endif TEST_REGEXP}
  7572. nil))))){$ifdef TEST_REGEXP}){$endif TEST_REGEXP};
  7573. Insert(CB1);
  7574. Insert(New(PLabel, Init(R1, label_replace_options, CB1)));
  7575. 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;
  7576. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  7577. New(RB1, Init(R2,
  7578. NewSItem(label_replace_forward,
  7579. NewSItem(label_replace_backward,
  7580. nil))));
  7581. Insert(RB1);
  7582. Insert(New(PLabel, Init(R1, label_replace_direction, RB1)));
  7583. 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;
  7584. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  7585. New(RB2, Init(R2,
  7586. NewSItem(label_replace_global,
  7587. NewSItem(label_replace_selectedtext,
  7588. nil))));
  7589. Insert(RB2);
  7590. Insert(New(PLabel, Init(R1, label_replace_scope, RB2)));
  7591. 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;
  7592. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  7593. New(RB3, Init(R2,
  7594. NewSItem(label_replace_fromcursor,
  7595. NewSItem(label_replace_entirescope,
  7596. nil))));
  7597. Insert(RB3);
  7598. Insert(New(PLabel, Init(R1, label_replace_origin, RB3)));
  7599. GetExtent(R); R.Grow(-13,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10; R.Move(-10,0);
  7600. Insert(New(PButton, Init(R, btn_OK, cmOK, bfDefault)));
  7601. R.Move(11,0); R.B.X:=R.A.X+14;
  7602. Insert(New(PButton, Init(R, btn_replace_changeall, cmYes, bfNormal)));
  7603. R.Move(15,0); R.B.X:=R.A.X+10;
  7604. Insert(New(PButton, Init(R, btn_Cancel, cmCancel, bfNormal)));
  7605. end;
  7606. IL1^.Select;
  7607. CreateReplaceDialog := D;
  7608. end;
  7609. function CreateGotoLineDialog(Info: pointer): PDialog;
  7610. var D: PDialog;
  7611. R,R1,R2: TRect;
  7612. Control : PView;
  7613. IL: PEditorInputLine;
  7614. begin
  7615. R.Assign(0,0,40,7);
  7616. New(D, Init(R, dialog_gotoline));
  7617. with D^ do
  7618. begin
  7619. Options:=Options or ofCentered;
  7620. GetExtent(R); R.Grow(-3,-2); R.B.Y:=R.A.Y+1;
  7621. R1.Copy(R); R1.B.X:=27; R2.Copy(R);
  7622. R2.B.X:=R2.B.X-3;R2.A.X:=27;
  7623. New(IL, Init(R2,5));
  7624. with TGotoLineDialogRec(Info^) do
  7625. IL^.SetValidator(New(PRangeValidator, Init(1, Lines)));
  7626. Insert(IL);
  7627. Insert(New(PLabel, Init(R1, label_gotoline_linenumber, IL)));
  7628. R1.Assign(R2.B.X, R2.A.Y, R2.B.X+3, R2.B.Y);
  7629. Control := New(PHistory, Init(R1, IL, GotoId));
  7630. Insert(Control);
  7631. GetExtent(R); R.Grow(-8,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10;
  7632. Insert(New(PButton, Init(R, btn_OK, cmOK, bfDefault)));
  7633. R.Move(15,0);
  7634. Insert(New(PButton, Init(R, btn_Cancel, cmCancel, bfNormal)));
  7635. end;
  7636. IL^.Select;
  7637. CreateGotoLineDialog:=D;
  7638. end;
  7639. function StdEditorDialog(Dialog: Integer; Info: Pointer): Word;
  7640. var
  7641. R: TRect;
  7642. T: TPoint;
  7643. Re: word;
  7644. Name: string;
  7645. DriveNumber : byte;
  7646. StoreDir,StoreDir2 : DirStr;
  7647. Title,DefExt: string;
  7648. AskOW: boolean;
  7649. begin
  7650. case Dialog of
  7651. edOutOfMemory:
  7652. StdEditorDialog := AdvMessageBox(msg_notenoughmemoryforthisoperation,
  7653. nil, mfInsertInApp+ mfError + mfOkButton);
  7654. edReadError:
  7655. StdEditorDialog := AdvMessageBox(msg_errorreadingfile,
  7656. @Info, mfInsertInApp+ mfError + mfOkButton);
  7657. edWriteError:
  7658. StdEditorDialog := AdvMessageBox(msg_errorwritingfile,
  7659. @Info, mfInsertInApp+ mfError + mfOkButton);
  7660. edSaveError:
  7661. StdEditorDialog := AdvMessageBox(msg_errorsavingfile,
  7662. @Info, mfInsertInApp+ mfError + mfOkButton);
  7663. edCreateError:
  7664. StdEditorDialog := AdvMessageBox(msg_errorcreatingfile,
  7665. @Info, mfInsertInApp+ mfError + mfOkButton);
  7666. edSaveModify:
  7667. StdEditorDialog := AdvMessageBox(msg_filehasbeenmodifiedsave,
  7668. @Info, mfInsertInApp+ mfInformation + mfYesNoCancel);
  7669. edSaveUntitled:
  7670. StdEditorDialog := AdvMessageBox(msg_saveuntitledfile,
  7671. nil, mfInsertInApp+ mfInformation + mfYesNoCancel);
  7672. edChangedOnloading:
  7673. StdEditorDialog := AdvMessageBox(msg_filehadtoolonglines,
  7674. Info, mfInsertInApp+ mfOKButton + mfInformation);
  7675. edFileOnDiskChanged:
  7676. StdEditorDialog := AdvMessageBox(msg_filewasmodified,
  7677. @info, mfInsertInApp+ mfInformation + mfYesNoCancel);
  7678. edReloadDiskmodifiedFile:
  7679. StdEditorDialog := AdvMessageBox(msg_reloaddiskmodifiedfile,
  7680. @info, mfInsertInApp+ mfInformation + mfYesNoCancel);
  7681. edReloadDiskAndIDEModifiedFile:
  7682. StdEditorDialog := AdvMessageBox(msg_reloaddiskandidemodifiedfile,
  7683. @info, mfInsertInApp+ mfInformation + mfYesNoCancel);
  7684. edSaveAs,edWriteBlock,edReadBlock:
  7685. begin
  7686. Name:=PString(Info)^;
  7687. GetDir(0,StoreDir);
  7688. DriveNumber:=0;
  7689. if (Length(FileDir)>1) and (FileDir[2]=':') then
  7690. begin
  7691. { does not assume that lowercase are greater then uppercase ! }
  7692. if (FileDir[1]>='a') and (FileDir[1]<='z') then
  7693. DriveNumber:=Ord(FileDir[1])-ord('a')+1
  7694. else
  7695. DriveNumber:=Ord(FileDir[1])-ord('A')+1;
  7696. GetDir(DriveNumber,StoreDir2);
  7697. {$I-}
  7698. ChDir(Copy(FileDir,1,2));
  7699. EatIO;
  7700. {$I+}
  7701. end;
  7702. if FileDir<>'' then
  7703. begin
  7704. {$I-}
  7705. ChDir(TrimEndSlash(FileDir));
  7706. EatIO;
  7707. {$I+}
  7708. end;
  7709. case Dialog of
  7710. edSaveAs :
  7711. begin
  7712. Title:=dialog_savefileas;
  7713. DefExt:='*'+DefaultSaveExt;
  7714. end;
  7715. edWriteBlock :
  7716. begin
  7717. Title:=dialog_writeblocktofile;
  7718. DefExt:='*.*';
  7719. end;
  7720. edReadBlock :
  7721. begin
  7722. Title:=dialog_readblockfromfile;
  7723. DefExt:='*.*';
  7724. end;
  7725. else begin Title:='???'; DefExt:=''; end;
  7726. end;
  7727. Re:=Application^.ExecuteDialog(New(PFPFileDialog, Init(DefExt,
  7728. Title, label_name, fdOkButton, FileId)), @Name);
  7729. case Dialog of
  7730. edSaveAs :
  7731. begin
  7732. if ExtOf(Name)='' then
  7733. Name:=Name+DefaultSaveExt;
  7734. AskOW:=(Name<>PString(Info)^);
  7735. end;
  7736. edWriteBlock :
  7737. begin
  7738. if ExtOf(Name)='' then
  7739. Name:=Name+DefaultSaveExt;
  7740. AskOW:=true;
  7741. end;
  7742. edReadBlock : AskOW:=false;
  7743. else AskOW:=true;
  7744. end;
  7745. if (Re<>cmCancel) and AskOW then
  7746. begin
  7747. FileDir:=DirOf(FExpand(Name));
  7748. if ExistsFile(Name) then
  7749. if EditorDialog(edReplaceFile,@Name)<>cmYes then
  7750. Re:=cmCancel;
  7751. end;
  7752. if DriveNumber<>0 then
  7753. ChDir(StoreDir2);
  7754. if StoreDir<>'' then
  7755. ChDir(TrimEndSlash(StoreDir));
  7756. if Re<>cmCancel then
  7757. PString(Info)^:=Name;
  7758. StdEditorDialog := Re;
  7759. end;
  7760. edGotoLine:
  7761. StdEditorDialog :=
  7762. Application^.ExecuteDialog(CreateGotoLineDialog(Info), Info);
  7763. edFind:
  7764. StdEditorDialog :=
  7765. Application^.ExecuteDialog(CreateFindDialog, Info);
  7766. edSearchFailed:
  7767. StdEditorDialog := AdvMessageBox(msg_searchstringnotfound,
  7768. nil, mfInsertInApp+ mfError + mfOkButton);
  7769. edReplace:
  7770. StdEditorDialog :=
  7771. Application^.ExecuteDialog(CreateReplaceDialog, Info);
  7772. edReplacePrompt:
  7773. begin
  7774. { Avoid placing the dialog on the same line as the cursor }
  7775. R.Assign(0, 1, 40, 8);
  7776. R.Move((Desktop^.Size.X - R.B.X) div 2, 0);
  7777. Desktop^.MakeGlobal(R.B, T);
  7778. Inc(T.Y);
  7779. if PPoint(Info)^.Y <= T.Y then
  7780. R.Move(0, Desktop^.Size.Y - R.B.Y - 2);
  7781. StdEditorDialog := AdvMessageBoxRect(R, msg_replacethisoccourence,
  7782. nil, mfInsertInApp+ mfYesNoCancel + mfInformation);
  7783. end;
  7784. edReplaceFile :
  7785. StdEditorDialog :=
  7786. AdvMessageBox(msg_fileexistsoverwrite,@Info,mfInsertInApp+mfConfirmation+
  7787. mfYesButton+mfNoButton);
  7788. end;
  7789. end;
  7790. procedure RegisterWEditor;
  7791. begin
  7792. {$ifndef NOOBJREG}
  7793. {$endif}
  7794. end;
  7795. END.