12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415 |
- MODULE WMTextView; (** AUTHOR "TF"; PURPOSE "Generic unicode text viewer"; *)
- IMPORT
- Kernel, Modules, Inputs, KernelLog, XML, Texts, TextUtilities, SyntaxHighlighter,
- WMGraphics, WMGraphicUtilities, WMMessages, WMComponents,
- WMStandardComponents, Strings, WMDropTarget, Raster,
- WMRectangles, WMWindowManager, WMProperties,
- Commands, FileHandlers, Streams, WMPopups, FP1616,
- WMPieMenu, WMEvents, UnicodeBidirectionality, PositionDebugging, ContextualDependency, D := Debugging;
- CONST
- TraceRenderOptimize = 0;
- TraceLayout = 1;
- TraceBaseLine = 2;
- TraceInvalidate = 3;
- TraceCopy = 4;
- TraceCommands = 5;
- Trace = {};
- (* When pressing the middle mouse button and holding down ALT, execute this command with
- the actual command and its parameters as parameter *)
- AltMMCommand = "WMUtilities.Call";
- CallURLPointer = 0; (* mousebutton which will invoke the URL *)
- (** Text wrapping modes (default = WrapWord) *)
- NoWrap* = 0; Wrap* = 1; WrapWord* = 2;
- AlignLeft = 0; AlignCenter = 1; AlignRight = 2;
- DragDist = 5;
- MaxCallParameterBuf = 1 * 1024 * 1024;
- MaxCommandLength = 256; (* without parameters *)
- (* If TRUE, a mouse right click will open a pie menu *)
- UsePieMenu = TRUE;
- InterclickNone = 0;
- Interclick01 = 1; (* mouse button 0 & 1 *)
- Interclick02 = 2; (* mouse button 0 & 2 *)
- InterclickCancelled = 99;
- SelectionColor = 0000FF60H;
- SelectionColorInterclick01 = LONGINT(0FFFF0060H);
- SelectionColorInterclick02 = LONGINT(0FF000060H);
- TYPE
- Char32 = Texts.Char32;
- ClickInfo = OBJECT
- VAR
- cmd, cmdPar : Strings.String;
- END ClickInfo;
- TabStops* = OBJECT
- VAR tabDist : LONGINT;
- (* return the next TabStop from the x position *)
- PROCEDURE GetNextTabStop*(x : LONGINT) : LONGINT;
- BEGIN
- RETURN ((x DIV tabDist) + 1) * tabDist
- END GetNextTabStop;
- END TabStops;
- TabPositions* = POINTER TO ARRAY OF LONGINT;
- CustomTabStops* = OBJECT (TabStops)
- VAR
- positions : TabPositions;
- PROCEDURE GetNextTabStop*(x : LONGINT) : LONGINT;
- VAR
- idx : LONGINT;
- BEGIN
- idx := 0;
- ASSERT(positions # NIL);
- IF x >= positions[LEN(positions) - 1] THEN RETURN GetNextTabStop^(x) END; (* return default tab stop *)
- WHILE x >= positions[idx] DO INC(idx) END;
- RETURN positions[idx]
- END GetNextTabStop;
- PROCEDURE &New *(tp : TabPositions);
- VAR
- idx : LONGINT;
- BEGIN
- idx := 0; tabDist := 150;
- WHILE idx < LEN(tp)-1 DO ASSERT(tp[idx] <= tp[idx+1]); INC(idx) END;
- positions := tp
- END New;
- END CustomTabStops;
- LineInfo = RECORD
- leftIndent, rightIndent, firstIndent, spaceBefore, spaceAfter : LONGINT;
- firstInParagraph, lastInParagraph : BOOLEAN;
- height, width, ascent : LONGINT;
- pos : LONGINT; (* the position in the text, where this line starts *)
- align : LONGINT;
- tabStops : TabStops;
- END;
- LineInfoArray = POINTER TO ARRAY OF LineInfo;
- TYPE
- Layout = OBJECT
- VAR
- nofLines : LONGINT;
- lines : LineInfoArray;
- text : Texts.Text;
- paperWidth : LONGINT;
- textWidth : LONGINT; (* maximal width of the text <= textWidth *)
- textHeight : LONGINT;
- layoutLineProc : PROCEDURE {DELEGATE} (VAR pos : LONGINT; VAR ch : Char32; VAR lineInfo : LineInfo; wrapWidth, stopPos, stopXPos : LONGINT);
- bidiFormatter : UnicodeBidirectionality.BidiFormatter;
- initialized : BOOLEAN;
- PROCEDURE &New*;
- BEGIN
- NEW(lines, 4);
- (* this helps saving some bidi computations *)
- initialized := FALSE;
- END New;
- (** Replace the text *)
- PROCEDURE SetText(text : Texts.Text);
- BEGIN
- ASSERT(text # NIL);
- SELF.text := text;
- END SetText;
- PROCEDURE GrowLines;
- VAR i : LONGINT; newLines : LineInfoArray;
- BEGIN
- NEW(newLines, LEN(lines) * 2);
- FOR i := 0 TO LEN(lines) - 1 DO newLines[i] := lines[i] END;
- lines := newLines
- END GrowLines;
- (** find the linenumber by the position *)
- PROCEDURE FindLineNrByPos(pos : LONGINT) : LONGINT;
- VAR a, b, m : LONGINT;
- BEGIN
- a := 0; b := nofLines - 1;
- WHILE (a < b) DO m := (a + b) DIV 2;
- IF lines[m].pos <= pos THEN a := m + 1
- ELSE b := m
- END
- END;
- (* last line hack *)
- IF lines[a].pos <= pos THEN INC(a) END;
- RETURN a - 1
- END FindLineNrByPos;
- PROCEDURE GetLineStartPos(lineNr : LONGINT) : LONGINT;
- BEGIN
- IF (lineNr >= 0) & (lineNr < nofLines) THEN RETURN lines[lineNr].pos ELSE RETURN 0 END
- END GetLineStartPos;
- (** return the length in characters of this line *)
- PROCEDURE GetLineLength(lineNr : LONGINT) : LONGINT;
- BEGIN
- IF (lineNr >= 0) & (lineNr < nofLines - 1) THEN RETURN lines[lineNr + 1].pos - lines[lineNr].pos
- ELSE
- IF (lineNr >= 0) & (lineNr < nofLines) THEN RETURN text.GetLength() - lines[lineNr].pos + 1
- ELSE RETURN 0
- END
- END
- END GetLineLength;
- PROCEDURE GetNofLines() : LONGINT;
- BEGIN
- RETURN nofLines
- END GetNofLines;
- PROCEDURE LayoutLine(VAR pos : LONGINT; VAR lineInfo : LineInfo);
- VAR
- dummyCh : Char32;
- BEGIN
- IF layoutLineProc # NIL THEN layoutLineProc(pos, dummyCh, lineInfo, paperWidth, -1, -1) END
- END LayoutLine;
- (* generate a new layout from scratch. if the text has not actually changed, no bidi-reformatting needs to be done *)
- PROCEDURE FullLayout(textChanged : BOOLEAN);
- VAR i, pos, oldpos : LONGINT;
- BEGIN
- ASSERT((text # NIL) & (lines#NIL));
- text.AcquireRead;
- textWidth := 0;
- IF TraceLayout IN Trace THEN KernelLog.String("FullLayout"); KernelLog.Ln END;
- (* create a new bidiformatter and reformat the whole text if necessary *)
- IF textChanged & initialized & text.isUTF THEN
- NEW(bidiFormatter,text);
- bidiFormatter.ReformatText;
- END;
- i := 0;
- pos := 0; nofLines := 0; textHeight := 0;
- WHILE pos < text.GetLength() DO
- oldpos := pos;
- LayoutLine(pos, lines[nofLines]); INC(textHeight, lines[nofLines].height);
- textWidth := Strings.Max(textWidth, lines[nofLines].width);
- ASSERT(pos > oldpos);
- IF TraceLayout IN Trace THEN KernelLog.String("Line from : "); KernelLog.Int(lines[nofLines].pos, 5); KernelLog.Ln END;
- INC(nofLines); IF nofLines >= LEN(lines) THEN GrowLines END
- END;
- IF TraceLayout IN Trace THEN KernelLog.String("FullLayout found "); KernelLog.Int(nofLines, 4); KernelLog.String(" lines"); KernelLog.Ln END;
- text.ReleaseRead
- END FullLayout;
- (** Fix the layouting of the text starting at pos where delta characters have been inserted (delta negativ if deleted) *)
- PROCEDURE FixLayoutFrom(pos, delta : LONGINT; VAR first, last : LONGINT; VAR linesChanged : BOOLEAN);
- VAR l, dl, oldh : LONGINT;
- BEGIN
- ASSERT(text # NIL);
- text.AcquireRead;
- linesChanged := FALSE;
- l := FindLineNrByPos(pos);
- IF (l < 0) THEN FullLayout(TRUE); first := 0; last := nofLines; text.ReleaseRead; RETURN END;
- pos := lines[l].pos;
- oldh := lines[l].height;
- LayoutLine(pos, lines[l]);
- IF oldh # lines[l].height THEN linesChanged := TRUE END;
- first := l;
- INC(l); dl := 0;
- IF (delta < 0) THEN
- IF (l >= nofLines) OR (lines[l].pos + delta = pos) THEN
- last := l;
- WHILE (l < nofLines) DO lines[l].pos := lines[l].pos + delta; INC(l) END
- ELSE
- linesChanged := TRUE;
- WHILE (pos < text.GetLength()) DO
- DEC(textHeight, lines[l].height);
- LayoutLine(pos, lines[l]);
- textWidth := Strings.Max(textWidth, lines[l].width);
- INC(textHeight, lines[nofLines].height);
- INC(dl);
- IF TraceLayout IN Trace THEN KernelLog.String("Line from : "); KernelLog.Int(lines[nofLines].pos, 5); KernelLog.Ln END;
- INC(l);
- IF l >= LEN(lines) THEN GrowLines END
- END;
- nofLines := l ;
- last := nofLines - 1
- END
- ELSE
- WHILE (pos < text.GetLength()) & (lines[l].pos + delta # pos) DO
- linesChanged := TRUE;
- DEC(textHeight, (lines[l].height));
- LayoutLine(pos, lines[l]);
- textWidth := Strings.Max(textWidth, lines[l].width);
- INC(textHeight, (lines[nofLines].height));
- INC(dl);
- IF TraceLayout IN Trace THEN KernelLog.String("Line from : "); KernelLog.Int(lines[nofLines].pos, 5); KernelLog.Ln END;
- INC(l); IF l >= LEN(lines) THEN GrowLines END
- END;
- last := l;
- IF TraceLayout IN Trace THEN
- KernelLog.String("Delta Lines : "); KernelLog.Int(dl, 4); KernelLog.Ln;
- KernelLog.String("Lines to redraw : "); KernelLog.Int(first, 5); KernelLog.String(" to "); KernelLog.Int(last, 5); KernelLog.Ln
- END;
- (* fix up the positions *)
- IF l < nofLines THEN WHILE (l < nofLines) DO lines[l].pos := lines[l].pos + delta; INC(l) END
- ELSE nofLines := l
- END
- END;
- text.ReleaseRead
- END FixLayoutFrom;
- END Layout;
- CONST HLOver* = 0; HLUnder* = 1; HLWave* = 2;
- TYPE
- Highlight* = OBJECT
- VAR
- kind : LONGINT;
- from*, to* : Texts.TextPosition;
- a*, b* : LONGINT; (* only valid after sort, while holding the lock *)
- active* : BOOLEAN; (* only valid after sort, while holding the lock *)
- oldFrom, oldTo : LONGINT;
- oldColor, color : WMGraphics.Color;
- text : Texts.UnicodeText;
- onChanged : WMMessages.CompCommand;
- PROCEDURE &New*;
- BEGIN
- color := SelectionColor;
- oldColor := color;
- END New;
- PROCEDURE SetKind*(kind : LONGINT);
- BEGIN
- IF SELF.kind # kind THEN
- SELF.kind := kind;
- onChanged(SELF, NIL)
- END
- END SetKind;
- PROCEDURE SetColor*(color : WMGraphics.Color);
- BEGIN
- oldColor := SELF.color;
- IF SELF.color # color THEN
- SELF.color := color;
- onChanged(SELF, NIL)
- END
- END SetColor;
- PROCEDURE SetFrom*(from : LONGINT);
- BEGIN
- IF text = NIL THEN RETURN END; (* if no text is set, the position within is undef *)
- text.AcquireRead;
- oldFrom := SELF.from.GetPosition();
- IF oldFrom # from THEN
- SELF.from.SetPosition(from);
- onChanged(SELF, NIL)
- END;
- text.ReleaseRead
- END SetFrom;
- PROCEDURE SetTo*(to : LONGINT);
- BEGIN
- IF text = NIL THEN RETURN END; (* if no text is set, the position within is undef *)
- text.AcquireRead;
- oldTo := SELF.to.GetPosition();
- IF oldTo # to THEN
- SELF.to.SetPosition(to);
- onChanged(SELF, NIL)
- END;
- text.ReleaseRead
- END SetTo;
- PROCEDURE SetFromTo*(from, to : LONGINT);
- BEGIN
- IF text = NIL THEN RETURN END; (* if no text is set, the position within is undef *)
- text.AcquireRead;
- oldTo := SELF.to.GetPosition();
- oldFrom := SELF.from.GetPosition();
- IF (oldTo # to) OR (oldFrom # from) THEN
- IF ((oldTo = oldFrom) & (to = from)) THEN
- SELF.to.SetPosition(to);
- SELF.from.SetPosition(from)
- ELSE
- SELF.to.SetPosition(to);
- SELF.from.SetPosition(from);
- onChanged(SELF, NIL)
- END
- END;
- text.ReleaseRead
- END SetFromTo;
- PROCEDURE Sort*;
- VAR t : LONGINT;
- BEGIN
- a := from.GetPosition();
- b := to.GetPosition();
- IF a > b THEN t := a; a := b; b := t END;
- active := a # b
- END Sort;
- PROCEDURE SetText(text : Texts.UnicodeText);
- BEGIN
- IF text # NIL THEN SELF.text := text; NEW(from, text); NEW(to, text) END
- END SetText;
- END Highlight;
- HighlightArray = POINTER TO ARRAY OF Highlight;
- TYPE
- PositionMarker* = OBJECT
- VAR
- pos : Texts.TextPosition;
- img : WMGraphics.Image;
- color : WMGraphics.Color;
- hotX, hotY : LONGINT;
- currentArea : WMRectangles.Rectangle;
- text : Texts.UnicodeText;
- onChanged : WMMessages.CompCommand;
- visible : BOOLEAN;
- PROCEDURE &Init*;
- BEGIN
- color := LONGINT(0FF0000CCH); visible := TRUE
- END Init;
- PROCEDURE Draw(canvas : WMGraphics.Canvas; x, y, ascent : LONGINT);
- BEGIN
- IF ~visible THEN RETURN END;
- IF img # NIL THEN canvas.DrawImage(x - hotX, y - hotY, img, WMGraphics.ModeSrcOverDst)
- ELSE
- currentArea := GetArea(x, y, ascent);
- canvas.Fill(currentArea, LONGINT(0FF0000CCH), WMGraphics.ModeSrcOverDst)
- END
- END Draw;
- PROCEDURE GetArea(x, y, ascent : LONGINT) : WMRectangles.Rectangle;
- BEGIN
- IF img # NIL THEN RETURN WMRectangles.MakeRect(x - hotX, y - hotY, x - hotX + img.width, y - hotY + img.height)
- ELSE RETURN WMRectangles.MakeRect(x , y - ascent, x + 2, y)
- END
- END GetArea;
- PROCEDURE Load*(CONST filename : ARRAY OF CHAR);
- BEGIN
- img := WMGraphics.LoadImage(filename, TRUE);
- IF img # NIL THEN hotX := img.width DIV 2; hotY := img.height DIV 2 END;
- onChanged(SELF, NIL)
- END Load;
- PROCEDURE SetVisible*(visible : BOOLEAN);
- BEGIN
- IF SELF.visible # visible THEN
- SELF.visible := visible;
- onChanged(SELF, NIL)
- END
- END SetVisible;
- PROCEDURE SetPosition*(pos : LONGINT);
- BEGIN
- IF text = NIL THEN RETURN END; (* if no text is set, the position within is undef *)
- text.AcquireRead;
- IF pos # SELF.pos.GetPosition() THEN
- SELF.pos.SetPosition(pos);
- onChanged(SELF, NIL)
- END;
- text.ReleaseRead
- END SetPosition;
- PROCEDURE GetPosition*() : LONGINT;
- BEGIN
- RETURN pos.GetPosition()
- END GetPosition;
- PROCEDURE SetColor*(color : WMGraphics.Color);
- BEGIN
- IF SELF.color # color THEN
- SELF.color := color;
- onChanged(SELF, NIL)
- END
- END SetColor;
- PROCEDURE SetText(text : Texts.UnicodeText);
- BEGIN
- IF text # NIL THEN
- SELF.text := text;
- NEW(pos, text);
- END
- END SetText;
- PROCEDURE SetNextInternalPosition*(next : LONGINT);
- BEGIN
- pos.nextInternalPos := next;
- END SetNextInternalPosition;
- PROCEDURE GetNextInternalPosition*() : LONGINT;
- BEGIN
- RETURN pos.nextInternalPos;
- END GetNextInternalPosition;
- END PositionMarker;
- PositionMarkerArray = POINTER TO ARRAY OF PositionMarker;
- TYPE
- Cursor = OBJECT(PositionMarker)
- VAR
- isVisible : BOOLEAN;
- PROCEDURE &Init*;
- BEGIN
- isVisible := TRUE;
- END Init;
- PROCEDURE SetCurrentVisibility(isVisible : BOOLEAN);
- BEGIN
- IF (SELF.isVisible # isVisible) THEN
- SELF.isVisible := isVisible;
- onChanged(SELF, NIL);
- END;
- END SetCurrentVisibility;
- PROCEDURE GetArea(x, y, ascent : LONGINT) : WMRectangles.Rectangle;
- BEGIN
- IF img # NIL THEN RETURN WMRectangles.MakeRect(x - hotX, y - hotY, x - hotX + img.width, y - hotY + img.height)
- ELSE RETURN WMRectangles.MakeRect(x , y - ascent - 2, x + 1, y + 2)
- END
- END GetArea;
- PROCEDURE Draw(canvas : WMGraphics.Canvas; x, y, ascent : LONGINT);
- BEGIN
- IF ~visible OR ~isVisible THEN RETURN END;
- IF img # NIL THEN canvas.DrawImage(x - hotX, y - hotY, img, WMGraphics.ModeSrcOverDst)
- ELSE
- currentArea := GetArea(x, y, ascent);
- canvas.Fill(currentArea, WMGraphics.Black, WMGraphics.ModeSrcOverDst)
- END
- END Draw;
- END Cursor;
- TYPE
- CursorBlinkerCallback = PROCEDURE {DELEGATE} (isVisible : BOOLEAN);
- (** Global thread that periodically toggles the visibility of the currently active cursor *)
- CursorBlinker* = OBJECT
- VAR
- cursor : ANY;
- callback : CursorBlinkerCallback;
- interval : LONGINT;
- isVisible : BOOLEAN;
- alive, dead : BOOLEAN;
- timer : Kernel.Timer;
- PROCEDURE &Init;
- BEGIN
- cursor := NIL; callback := NIL;
- interval := 500;
- isVisible := TRUE;
- alive := TRUE; dead := FALSE;
- NEW(timer);
- END Init;
- (** Set the currently active cursor and a callback that will be periodically called *)
- PROCEDURE Set*(cursor : ANY; callback : CursorBlinkerCallback);
- BEGIN {EXCLUSIVE}
- ASSERT((cursor # NIL) & (callback # NIL));
- IF (SELF.cursor # NIL) THEN callback(TRUE); END;
- SELF.cursor := cursor;
- SELF.callback := callback;
- isVisible := TRUE;
- timer.Wakeup;
- END Set;
- (** Set the cursor blinking interval in milliseconds. An interval of MAX(LONGINT) means don't blink *)
- PROCEDURE SetInterval*(ms : LONGINT);
- BEGIN {EXCLUSIVE}
- ASSERT(ms > 0);
- interval := ms;
- timer.Wakeup;
- IF (interval = MAX(LONGINT)) & (cursor # NIL) THEN
- isVisible := TRUE;
- callback(isVisible);
- END;
- END SetInterval;
- (** If 'cursor' is the currently active cursor, set the currently active cursor to NIL *)
- PROCEDURE Remove*(cursor : ANY);
- BEGIN {EXCLUSIVE}
- ASSERT(cursor # NIL);
- IF (SELF.cursor = cursor) THEN
- SELF.cursor := NIL;
- SELF.callback := NIL;
- END;
- END Remove;
- (** If 'cursor' is the currently active cursor, show it for one period *)
- PROCEDURE Show*(cursor : ANY);
- BEGIN {EXCLUSIVE}
- ASSERT(cursor # NIL);
- IF (SELF.cursor = cursor) THEN
- isVisible := TRUE;
- timer.Wakeup;
- END;
- END Show;
- PROCEDURE Finalize;
- BEGIN
- BEGIN {EXCLUSIVE} alive := FALSE; END;
- timer.Wakeup;
- BEGIN {EXCLUSIVE} AWAIT(dead); END;
- END Finalize;
- BEGIN {ACTIVE}
- WHILE alive DO
- BEGIN {EXCLUSIVE}
- AWAIT(~alive OR ((cursor # NIL) & (interval # MAX(LONGINT))));
- IF alive THEN
- callback(isVisible);
- isVisible := ~isVisible;
- END;
- END;
- timer.Sleep(interval);
- END;
- BEGIN {EXCLUSIVE} dead := TRUE; END;
- END CursorBlinker;
- TYPE
- TextDropTarget* = OBJECT(WMDropTarget.DropTarget);
- VAR text : Texts.Text;
- pos : Texts.TextPosition;
- PROCEDURE &New*(text : Texts.Text; pos : Texts.TextPosition);
- BEGIN
- SELF.text := text; SELF.pos := pos
- END New;
- PROCEDURE GetInterface*(type : LONGINT) : WMDropTarget.DropInterface;
- VAR di : WMDropTarget.DropText;
- BEGIN
- IF type = WMDropTarget.TypeText THEN
- NEW(di); di.text := text; di.pos := pos;
- RETURN di
- ELSE RETURN NIL
- END
- END GetInterface;
- END TextDropTarget;
- TYPE
- LinkWrapper* = POINTER TO RECORD
- link* : Texts.Link;
- END;
- TYPE
- TextView* = OBJECT(WMComponents.VisualComponent)
- VAR
- defaultTextColor-, defaultTextBgColor- : WMProperties.ColorProperty;
- defaultTextColorI, defaultTextBgColorI : LONGINT;
- isMultiLine- : WMProperties.BooleanProperty;
- isMultiLineI : BOOLEAN;
- (** Text wrapping mode: NoWrap, Wrap or WrapWord (default : WrapWord) *)
- wrapMode- : WMProperties.Int32Property;
- wrapModeI : LONGINT;
- firstLine- : WMProperties.Int32Property;
- firstLineI : LONGINT;
- leftShift- : WMProperties.Int32Property;
- leftShiftI : LONGINT; (* number of units, the view is shifted to left -> line scrolling *)
- showBorder- : WMProperties.BooleanProperty;
- showBorderI : BOOLEAN;
- borders- : WMProperties.RectangleProperty;
- bordersI, borderClip : WMRectangles.Rectangle;
- x0 : LONGINT; (* text starts at x = x0. Used to get column for line numbers in subclass CodeView *)
- alwaysShowCursor- : WMProperties.BooleanProperty;
- alwaysShowCursorI : BOOLEAN;
- showLabels- : WMProperties.BooleanProperty;
- (** Is set to TRUE, the characters will be replaced by passwordChar *)
- isPassword- : WMProperties.BooleanProperty;
- isPasswordI : BOOLEAN; (* cache of the property value to avoid per-character-locks *)
- passwordChar- : WMProperties.Int32Property; (* not cached *)
- (** Mouse wheel scrolling speed multiplier? (default: 3, 0: disable mouse wheel scrolling) *)
- mouseWheelScrollSpeed- : WMProperties.Int32Property;
- mouseWheelScrollSpeedI : LONGINT;
- (** Allow middle-click command execution? (default: TRUE) *)
- allowCommandExecution- : WMProperties.BooleanProperty;
- (** Allow text selection using the mouse? (default: TRUE) *)
- allowTextSelection- : WMProperties.BooleanProperty;
- (** Should a mouse right-click open the pie menu? (default : TRUE) *)
- allowPiemenu- : WMProperties.BooleanProperty;
- (** Syntax highlighting *)
- highlighting- : WMProperties.StringProperty;
- highlighter : SyntaxHighlighter.Highlighter;
- state : SyntaxHighlighter.State;
- fontCache : FontCache;
-
- (** vertical centering -- momentarily only working for a single line *)
- textAlignV-: WMProperties.Int32Property;
- showLineNumbers- : WMProperties.BooleanProperty;
- showLineNumbersI : BOOLEAN;
- lineNumberColor-, lineNumberBgColor- : WMProperties.ColorProperty;
- lineNumberColorI, lineNumberBgColorI : LONGINT;
- lineNumberFont, lineNumberFont10 : WMGraphics.Font;
- indicateTabs- : WMProperties.BooleanProperty;
- indicateTabsI : BOOLEAN;
- clBgCurrentLine- : WMProperties.ColorProperty;
- clBgCurrentLineI : LONGINT;
- selection- : Highlight;
- cursor- : Cursor;
- onLinkClicked- : WMEvents.EventSource;
- onCtrlClicked- : WMEvents.EventSource;
- (** Commands.Context.caller will be set to this object when executing a command *)
- commandCaller*: OBJECT;
- commandWriter*, errorWriter*: Streams.Writer;
- (** Called whenever the cursor position changes *)
- onCursorChanged* : PROCEDURE {DELEGATE};
- optimize* : BOOLEAN;
- piemenu : WMPieMenu.Menu;
- text : Texts.Text;
- layout : Layout;
- utilreader : Texts.TextReader; (* single process ! *)
- clipState : WMGraphics.CanvasState;
- defaultTabStops : TabStops;
- vScrollbar : WMStandardComponents.Scrollbar;
- hScrollbar : WMStandardComponents.Scrollbar;
- (* highlighting *)
- nofHighlights : LONGINT;
- highlights : HighlightArray;
- (* marked positions *)
- nofPositionMarkers : LONGINT;
- positionMarkers : PositionMarkerArray;
- lastCursorPos: LONGINT;
- selecting : BOOLEAN;
- doubleclickedWord : BOOLEAN;
- dragPossible : BOOLEAN;
- dragSelA, dragSelB : Texts.TextPosition;
- dragCopy : BOOLEAN;
- canStart, openFile : BOOLEAN; (* set for command selection mode *)
- commandMarker : Highlight;
- downX, downY : LONGINT;
- selectWords : BOOLEAN;
- wordSelOrdered : BOOLEAN;
- lineEnter : LONGINT;
- modifierFlags : SET;
- oldFlags : SET; (* old pointer flags *)
- interclick : LONGINT;
- lastTimeStamp : LONGINT;
- oldObject, focusObject : ANY;
- oldPos, focusPos : LONGINT;
- objHasFocus : BOOLEAN;
- PROCEDURE &Init*;
- BEGIN
- Init^;
- SetGenerator("WMTextView.GenTextView");
- SetNameAsString(StrTextView);
- (* properties *)
- NEW(defaultTextColor, PTVdefaultTextColor, NIL, NIL); properties.Add(defaultTextColor);
- NEW(defaultTextBgColor, PTVdefaultTextBgColor, NIL, NIL); properties.Add(defaultTextBgColor);
- NEW(isMultiLine, PTVIsMultiLine, NIL, NIL); properties.Add(isMultiLine);
- NEW(wrapMode, PTVWrapMode, NIL, NIL); properties.Add(wrapMode);
- NEW(firstLine, PTVfirstLine, NIL, NIL); properties.Add(firstLine);
- NEW(leftShift, PTVleftShift, NIL, NIL); properties.Add(leftShift);
- NEW(showBorder, PTVShowBorder, NIL, NIL); properties.Add(showBorder);
- NEW(borders, PTVborders, NIL, NIL); properties.Add(borders);
- NEW(alwaysShowCursor, PTValwaysShowCursor, NIL, NIL); properties.Add(alwaysShowCursor);
- NEW(showLabels, PTVShowLabels, NIL, NIL); properties.Add(showLabels);
- NEW(isPassword, PTVIsPassword, NIL, NIL); properties.Add(isPassword);
- NEW(passwordChar, PTVPasswordChar, NIL, NIL); properties.Add(passwordChar);
- NEW(mouseWheelScrollSpeed, PTVMouseWheelScrollSpeed, NIL, NIL); properties.Add(mouseWheelScrollSpeed);
- NEW(allowCommandExecution, PTVAllowCommandExecution, NIL, NIL); properties.Add(allowCommandExecution);
- NEW(allowTextSelection, PTVAllowTextSelection, NIL, NIL); properties.Add(allowTextSelection);
- NEW(allowPiemenu, PTVAllowPiemenu, NIL, NIL); properties.Add(allowPiemenu);
- NEW(highlighting, PTVHighlighting, NIL, NIL); properties.Add(highlighting);
- highlighter := NIL; state := NIL; fontCache := NIL;
- NEW(showLineNumbers, PTVShowLineNumbers, NIL, NIL); properties.Add(showLineNumbers);
- NEW(lineNumberColor, PTVLineNumberColor, NIL, NIL); properties.Add(lineNumberColor);
- NEW(lineNumberBgColor, PTVLineNumberBgColor, NIL, NIL); properties.Add(lineNumberBgColor);
- lineNumberFont := NIL; lineNumberFont10 := NIL;
- NEW(indicateTabs, PTVIndicateTabs, NIL, NIL); properties.Add(indicateTabs);
- NEW(clBgCurrentLine, PTVclBgCurrentLine, NIL, NIL); properties.Add(clBgCurrentLine);
- NEW(textAlignV, PVTtextAlignV, NIL, NIL); properties.Add(textAlignV);
- (* events *)
- NEW(onLinkClicked, SELF, PTVonLinkClick, PTVonLinkClickInfo, SELF.StringToCompCommand); events.Add(onLinkClicked);
- onLinkClicked.Add(LinkClicked);
- NEW(onCtrlClicked, SELF, PTVonCtrlLinkClick, PTVonCtrlLinkClickInfo, SELF.StringToCompCommand); events.Add(onCtrlClicked);
- (* selection and cursor *)
- NEW(layout);
- layout.layoutLineProc := LayoutLine;
- nofHighlights := 0;
- NEW(highlights, 4);
- nofPositionMarkers := 0;
- NEW(positionMarkers, 4); nofPositionMarkers := 0;
- selection := CreateHighlight();
- selection.kind := HLOver;
- selection.color := SelectionColor;
- cursor := CreateCursor();
- commandCaller := NIL;
- commandWriter := NIL;
- onCursorChanged := NIL;
- (* Initialization of internal fields *)
- optimize := FALSE;
- piemenu := NIL;
- text := NIL;
- utilreader := NIL;
- NEW(defaultTabStops); defaultTabStops.tabDist := 20;
- vScrollbar := NIL; hScrollbar := NIL;
- lastCursorPos := -1;
- selecting := FALSE;
- doubleclickedWord := FALSE;
- dragPossible := FALSE;
- dragSelA := NIL; dragSelB := NIL;
- canStart := FALSE; openFile := FALSE;
- downX := 0; downY := 0;
- selectWords := FALSE;
- wordSelOrdered := FALSE;
- lineEnter := 0;
- modifierFlags := {}; oldFlags := {};
- interclick := InterclickNone;
- lastTimeStamp := 0;
- oldObject := NIL; focusObject := NIL;
- oldPos := 0; focusPos := 0;
- objHasFocus := FALSE;
- takesFocus.Set(TRUE);
- needsTab.Set(TRUE);
- SetPointerInfo(manager.pointerText);
- END Init;
- PROCEDURE Initialize*;
- BEGIN
- ASSERT(IsCallFromSequencer());
- (*Initialize^; RecacheProperties;*)
-
- IF text#NIL THEN Resized END; (*implicit redundant invalidate in Resized *)(*! Resized is probably redundant*)
-
- (* from now on, bidi-formatting can be done *)
- layout.initialized := TRUE;
- Initialize^;
- cursor.SetVisible(FALSE);
- END Initialize;
- PROCEDURE Finalize;
- BEGIN
- Finalize^;
- IF text # NIL THEN text.onTextChanged.Remove(TextChanged); END;
- cursorBlinker.Remove(cursor);
- END Finalize;
- PROCEDURE FocusReceived*;
- BEGIN
- FocusReceived^;
- cursor.SetVisible(TRUE);
- cursorBlinker.Set(cursor, cursor.SetCurrentVisibility);
- (* let the module know that this is the currently visible TextView *)
- currentTextView := SELF;
- END FocusReceived;
- PROCEDURE FocusLost*;
- BEGIN
- FocusLost^;
- modifierFlags := {};
- cursorBlinker.Remove(cursor);
- SetInterclick(InterclickNone);
- IF ~alwaysShowCursorI THEN cursor.SetVisible(FALSE); END;
- END FocusLost;
- (* Inserts a character directly into the text. This should be used by external tools that insert character
- without the usage of the keyboard, e.g. WMUnicodeMarkerTool) *)
- PROCEDURE InsertChar(char : Char32) : INTEGER;
- VAR oneCharString : ARRAY 2 OF Texts.Char32;
- BEGIN
- (* Only insert a character into a valid text, that is either utf-formatted or gets a simple ASCII-character
- as input. *)
- IF text # NIL THEN
- IF text.isUTF OR (char < 256) THEN
- oneCharString[0] := char;
- oneCharString[1] := 0H;
- text.AcquireWrite;
- text.InsertUCS32(GetInternalPos(cursor.GetPosition()),oneCharString);
- text.ReleaseWrite;
- RETURN 0;
- ELSE
- RETURN -1;
- END;
- ELSE
- RETURN -2;
- END;
- END InsertChar;
- PROCEDURE RecacheProperties;
- VAR
- highlighter : SyntaxHighlighter.Highlighter;
- oldBorders : WMRectangles.Rectangle;
- string : Strings.String;
- BEGIN
- ASSERT(IsCallFromSequencer());
- RecacheProperties^;
-
- defaultTextColorI := defaultTextColor.Get();
- defaultTextBgColorI := defaultTextBgColor.Get();
- isMultiLineI := isMultiLine.Get();
- wrapModeI := wrapMode.Get();
- firstLineI := firstLine.Get();
- leftShiftI := leftShift.Get();
- showBorderI := showBorder.Get();
- oldBorders := bordersI;
- bordersI := borders.Get();
- alwaysShowCursorI := alwaysShowCursor.Get();
- mouseWheelScrollSpeedI := mouseWheelScrollSpeed.Get();
- isPasswordI := isPassword.Get();
- showLineNumbersI := showLineNumbers.Get();
- ShowLineNumbers(showLineNumbersI);
- lineNumberColorI := lineNumberColor.Get();
- lineNumberBgColorI := lineNumberBgColor.Get();
- indicateTabsI := indicateTabs.Get();
- clBgCurrentLineI := clBgCurrentLine.Get();
- string := highlighting.Get();
-
- IF (string # NIL) THEN
- highlighter := SyntaxHighlighter.GetHighlighter(string^);
- ELSE
- highlighter := NIL;
- END;
- IF text#NIL THEN
- SetSyntaxHighlighter(highlighter);
- UpdateScrollbars;
- IF ~WMRectangles.IsEqual(oldBorders, bordersI) THEN BordersChanged END;
- END;
- (*Invalidate;*)
- END RecacheProperties;
- PROCEDURE SetScrollbars*(hScrollbar, vScrollbar : WMStandardComponents.Scrollbar);
- BEGIN
- Acquire;
- IF hScrollbar # NIL THEN hScrollbar.onPositionChanged.Remove(ScrollbarsChanged) END;
- IF vScrollbar # NIL THEN vScrollbar.onPositionChanged.Remove(ScrollbarsChanged) END;
- SELF.hScrollbar := hScrollbar; SELF.vScrollbar := vScrollbar;
- IF hScrollbar # NIL THEN hScrollbar.onPositionChanged.Add(ScrollbarsChanged) END;
- IF vScrollbar # NIL THEN vScrollbar.onPositionChanged.Add(ScrollbarsChanged) END;
- UpdateScrollbars;
- Release
- END SetScrollbars;
- PROCEDURE ScrollbarsChanged(sender, data : ANY);
- BEGIN
- IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.ScrollbarsChanged, sender, data)
- ELSE
- IF sender = vScrollbar THEN firstLine.Set(vScrollbar.pos.Get())
- ELSIF sender = hScrollbar THEN leftShift.Set(hScrollbar.pos.Get())
- END
- END
- END ScrollbarsChanged;
- PROCEDURE UpdateScrollbars;
- BEGIN
- IF vScrollbar # NIL THEN
- vScrollbar.max.Set(layout.GetNofLines());
- vScrollbar.pos.Set(firstLineI);
- END;
- IF hScrollbar # NIL THEN
- IF (wrapModeI # NoWrap) THEN
- hScrollbar.visible.Set(FALSE);
- ELSE
- hScrollbar.visible.Set(TRUE);
- (* hScrollbar.visible.Set(layout.textWidth > bounds.GetWidth()); *)
- hScrollbar.max.Set(layout.textWidth);
- hScrollbar.pageSize.Set(bounds.GetWidth());
- hScrollbar.pos.Set(leftShiftI);
- END;
- END;
- END UpdateScrollbars;
- PROCEDURE BordersChanged;
- VAR vScroll : LONGINT;
- BEGIN
- ASSERT(IsCallFromSequencer());
- IF (vScrollbar # NIL) & (vScrollbar.visible.Get()) THEN vScroll := vScrollbar.bounds.GetWidth() ELSE vScroll := 0 END;
- borderClip := WMRectangles.MakeRect(bordersI.l, bordersI.t, bounds.GetWidth() - bordersI.r, bounds.GetHeight() - bordersI.b);
- layout.paperWidth := bounds.GetWidth() - (bordersI.l + bordersI.r) - vScroll;
- layout.FullLayout(FALSE); CheckNumberOfLines;
- END BordersChanged;
- PROCEDURE WrapModeChanged;
- BEGIN
- ASSERT(IsCallFromSequencer());
- wrapModeI := wrapMode.Get();
- IF (wrapModeI # NoWrap) THEN
- leftShift.Set(0); leftShiftI := 0; (* no scrollbars -> don't shift *)
- END;
- optimize := TRUE;
- layout.FullLayout(optimize);
- optimize := FALSE;
- UpdateScrollbars;
- (*Invalidate;*)
- END WrapModeChanged;
- PROCEDURE PropertyChanged*(sender, property : ANY);
- VAR
- highlighter : SyntaxHighlighter.Highlighter;
- oldBorders : WMRectangles.Rectangle;
- string : Strings.String;
- BEGIN
- IF property = defaultTextColor THEN
- defaultTextColorI := defaultTextColor.Get(); Invalidate;
- ELSIF property = defaultTextBgColor THEN
- defaultTextBgColorI := defaultTextBgColor.Get(); Invalidate;
- ELSIF property = isMultiLine THEN
- isMultiLineI := isMultiLine.Get(); Invalidate;
- ELSIF property = wrapMode THEN
- wrapModeI := wrapMode.Get(); WrapModeChanged; Invalidate;
- ELSIF property = firstLine THEN
- firstLineI := firstLine.Get(); UpdateScrollbars; Invalidate;
- ELSIF property = leftShift THEN
- leftShiftI := leftShift.Get(); UpdateScrollbars; Invalidate;
- ELSIF property = showBorder THEN
- showBorderI := showBorder.Get(); Invalidate;
- ELSIF property = borders THEN
- oldBorders := bordersI; bordersI := borders.Get(); BordersChanged; Invalidate;
- ELSIF property = alwaysShowCursor THEN
- alwaysShowCursorI := alwaysShowCursor.Get();
- IF (alwaysShowCursorI = TRUE) THEN cursor.SetVisible(TRUE);
- ELSIF ~hasFocus THEN cursor.SetVisible(FALSE);
- END;
- Invalidate;
- ELSIF property = mouseWheelScrollSpeed THEN
- mouseWheelScrollSpeedI := mouseWheelScrollSpeed.Get();
- ELSIF property = isPassword THEN
- isPasswordI := isPassword.Get(); Invalidate;
- ELSIF (property = highlighting) THEN
- string := highlighting.Get();
- IF (string # NIL) THEN
- highlighter := SyntaxHighlighter.GetHighlighter(string^);
- ELSE
- highlighter := NIL;
- END;
- SetSyntaxHighlighter(highlighter);
- ELSIF (property = showLineNumbers) THEN
- showLineNumbersI := showLineNumbers.Get();
- ShowLineNumbers(showLineNumbersI);
- Invalidate;
- ELSIF (property = indicateTabs) THEN
- indicateTabsI := indicateTabs.Get(); Invalidate;
- ELSIF (property = clBgCurrentLine) THEN
- clBgCurrentLineI := clBgCurrentLine.Get(); Invalidate;
- ELSIF (property = textAlignV) THEN
- Invalidate;
- ELSIF (property = lineNumberColor) OR (property = lineNumberBgColor) THEN
- lineNumberColorI := lineNumberColor.Get();
- lineNumberBgColorI := lineNumberBgColor.Get();
- Invalidate;
- ELSE
- PropertyChanged^(sender, property)
- END
- END PropertyChanged;
- PROCEDURE Resized;
- VAR prevWidth: LONGINT;
- BEGIN
- ASSERT(IsCallFromSequencer());
- Resized^; (*? here, an implicit Invalidate() is triggered - this is probably redundant *)
- prevWidth := layout.paperWidth;
- layout.paperWidth := bounds.GetWidth() - (bordersI.l + bordersI.r);
- borderClip.r := bounds.GetWidth() - bordersI.r; borderClip.b := bounds.GetHeight() - bordersI.b;
- IF (prevWidth # layout.paperWidth) & (wrapMode.Get()#NoWrap) THEN
- layout.FullLayout(optimize);
- END;
- CheckNumberOfLines;
- END Resized;
- (** Replace the text *)
- PROCEDURE SetText*(text : Texts.Text);
- VAR i : LONGINT;
- BEGIN
- ASSERT(text # NIL);
- Acquire;
- IF SELF.text # NIL THEN SELF.text.onTextChanged.Remove(TextChanged) END; (* unregister the TextChanged listener from the old text *)
- SELF.text := text;
- text.onTextChanged.Add(TextChanged); (* register the TextChanged listener with the new text*)
- NEW(utilreader, text);
- (* update all highlights *)
- FOR i := 0 TO nofHighlights - 1 DO highlights[i].SetText(text) END;
- FOR i := 0 TO nofPositionMarkers - 1 DO
- positionMarkers[i].SetText(text);
- (* Let the cursor know about the local position-translation procedures *)
- IF text.isUTF THEN
- positionMarkers[i].pos.SetInternalPositionTranslator(GetInternalPos);
- positionMarkers[i].pos.SetDisplayPositionTranslator(GetDisplayPos);
- END;
- END;
- text.AcquireRead; (* also protect SELF.highlighter and SELF.state here *)
- IF (highlighter # NIL) THEN
- ASSERT(state # NIL);
- highlighter.RebuildRegions(utilreader, state);
- END;
- layout.SetText(text);
- layout.FullLayout(TRUE);
- CheckNumberOfLines;
- ASSERT(((highlighter = NIL) & (state = NIL)) OR ((highlighter # NIL) & (state # NIL)));
- text.ReleaseRead;
- (*Invalidate;(*! Redundant ?*)*)
- Release;
- END SetText;
- PROCEDURE SetSyntaxHighlighter*(highlighter : SyntaxHighlighter.Highlighter);
- BEGIN
- ASSERT(text # NIL);
- Acquire;
- IF (SELF.highlighter # highlighter) & ((SELF.highlighter # NIL) OR (highlighter # NIL)) THEN
- text.AcquireRead; (* also protect SELF.highlighter and SELF.state here *)
- SELF.highlighter := highlighter;
- IF (highlighter # NIL) THEN
- IF (state = NIL) THEN
- state := highlighter.GetState();
- ASSERT(state # NIL);
- END;
- highlighter.RebuildRegions(utilreader, state);
- ELSE
- state := NIL;
- END;
- layout.FullLayout(TRUE);
- CheckNumberOfLines;
- ASSERT(((highlighter = NIL) & (state = NIL)) OR ((highlighter # NIL) & (state # NIL)));
- text.ReleaseRead;
- Invalidate;
- END;
- Release;
- END SetSyntaxHighlighter;
- PROCEDURE ShowLineNumbers(enabled : BOOLEAN);
- VAR font : WMGraphics.Font;
- BEGIN
- font := GetFont( );
- IF enabled THEN
- x0 := 55;
- lineNumberFont := WMGraphics.GetFont(font.name, font.size, {});
- lineNumberFont10 := WMGraphics.GetFont(font.name, font.size, {WMGraphics.FontBold});
- ELSE
- x0 := 0;
- lineNumberFont := NIL;
- lineNumberFont10 := NIL;
- END;
- END ShowLineNumbers;
- PROCEDURE SetTabStops*(ts : TabStops);
- BEGIN
- Acquire;
- defaultTabStops := ts;
- layout.FullLayout(TRUE);
- CheckNumberOfLines;
- Release;
- END SetTabStops;
- (* BEGIN highlighting *)
- PROCEDURE AddHighlight(highlight : Highlight);
- VAR newHighlights : HighlightArray; i : LONGINT;
- BEGIN
- INC(nofHighlights);
- IF nofHighlights > LEN(highlights) THEN
- NEW(newHighlights, LEN(highlights) * 2);
- FOR i := 0 TO LEN(highlights) - 1 DO newHighlights[i] := highlights[i] END;
- highlights := newHighlights;
- END;
- highlights[nofHighlights - 1] := highlight;
- HighlightChanged(highlight, NIL);
- END AddHighlight;
- PROCEDURE CreateHighlight*() : Highlight;
- VAR h : Highlight;
- BEGIN
- Acquire;
- NEW(h); h.SetText(text);
- h.onChanged := HighlightChanged;
- AddHighlight(h);
- Release;
- RETURN h
- END CreateHighlight;
- PROCEDURE RemoveHighlight*(x : Highlight);
- VAR i : LONGINT;
- BEGIN
- Acquire;
- i := 0; WHILE (i < nofHighlights) & (highlights[i] # x) DO INC(i) END;
- IF i < nofHighlights THEN
- WHILE (i < nofHighlights - 1) DO highlights[i] := highlights[i+1]; INC(i) END;
- DEC(nofHighlights);
- highlights[nofHighlights] := NIL
- END;
- HighlightChanged(NIL, NIL);
- Release
- END RemoveHighlight;
- PROCEDURE InvalidateRange(a, b : LONGINT);
- VAR
- t, l0, l1 : LONGINT;
- x0, y0, x1, y1, d : LONGINT;
- ia, ib : LONGINT;
- BEGIN
- ia := GetDisplayPos(a);
- ib := GetDisplayPos(b);
- (* Sort the display positions, not the internal positions so as not to get weird results! *)
- IF ia > ib THEN t := ia; ia := ib; ib := t END;
- l0 := layout.FindLineNrByPos(ia);
- l1 := layout.FindLineNrByPos(ib);
- IF l0 = l1 THEN (* only one line... optimize *)
- LineYPos(l0, y0, y1);
- (* if text is UTF-formatted (and thus might content RTL-text) the whole line is invalidated.
- this might - in some rare cases - be a bit slower than invalidating the minimum rectangle
- but is guaranteed to always be correct. *)
- IF text.isUTF OR (~(FindScreenPos(ia, x0, d) & FindScreenPos(ib, x1, d))) THEN
- x0 := 0; x1 := bounds.GetWidth();
- END;
- InvalidateRect(WMRectangles.MakeRect(x0, y0, x1, y1));
- ELSE
- LineYPos(l0, y0, d); LineYPos(l1, d, y1);
- InvalidateRect(WMRectangles.MakeRect(0, y0, bounds.GetWidth(), y1));
- END;
- IF TraceInvalidate IN Trace THEN KernelLog.String("ir ") END;
- END InvalidateRange;
- PROCEDURE HighlightChanged(sender, data : ANY);
- VAR hl : Highlight; min, max : LONGINT;
- BEGIN
- IF ~initialized THEN RETURN END;
- IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.HighlightChanged, sender, data)
- ELSE
- text.AcquireRead;
- IF (sender # NIL) & (sender IS Highlight) THEN
- hl := sender(Highlight);
- IF ((hl.oldFrom # hl.from.GetPosition()) & (hl.oldTo # hl.to.GetPosition())) OR (hl.oldColor # hl.color) THEN (* both changed *)
- min := Strings.Min(
- Strings.Min(hl.oldFrom, hl.from.GetPosition()),
- Strings.Min(hl.oldTo, hl.to.GetPosition()));
- max := Strings.Max(
- Strings.Max(hl.oldFrom, hl.from.GetPosition()),
- Strings.Max(hl.oldTo, hl.to.GetPosition()));
- InvalidateRange(min, max)
- ELSIF hl.oldTo # hl.to.GetPosition() THEN (* to changed *)
- InvalidateRange(hl.oldTo, hl.to.GetPosition())
- ELSIF hl.oldFrom # hl.from.GetPosition() THEN (* from changed *)
- InvalidateRange(hl.oldFrom, hl.from.GetPosition())
- ELSE (* position noch changed... probably color, style or visibility changed, invalidate range *)
- InvalidateRange(hl.from.GetPosition(),hl.to.GetPosition())
- END
- ELSE
- IF TraceInvalidate IN Trace THEN KernelLog.String("H") END;
- Invalidate
- END;
- text.ReleaseRead
- END
- END HighlightChanged;
- (* END highlighting *)
- (* BEGIN PositionMarkers *)
- PROCEDURE AddPositionMarker(pm : PositionMarker);
- VAR newPositionMarkers : PositionMarkerArray; i : LONGINT;
- BEGIN
- INC(nofPositionMarkers);
- IF nofPositionMarkers > LEN(positionMarkers) THEN
- NEW(newPositionMarkers, LEN(positionMarkers) * 2);
- FOR i := 0 TO LEN(positionMarkers) - 1 DO newPositionMarkers[i] := positionMarkers[i] END;
- positionMarkers := newPositionMarkers
- END;
- positionMarkers[nofPositionMarkers - 1] := pm
- END AddPositionMarker;
- PROCEDURE CreatePositionMarker*() : PositionMarker;
- VAR p : PositionMarker;
- BEGIN
- Acquire;
- NEW(p); p.SetText(text);
- p.onChanged := PositionMarkerChanged;
- AddPositionMarker(p);
- Release;
- RETURN p
- END CreatePositionMarker;
- PROCEDURE CreateCursor*() : Cursor;
- VAR p : Cursor;
- BEGIN
- Acquire;
- NEW(p); p.SetText(text);
- p.onChanged := PositionMarkerChanged;
- AddPositionMarker(p);
- Release;
- RETURN p
- END CreateCursor;
- PROCEDURE RemovePositionMarker*(x : PositionMarker);
- VAR i, xp, yp, l, ascent : LONGINT; newRect : WMRectangles.Rectangle;
- BEGIN
- Acquire;
- i := 0; WHILE (i < nofPositionMarkers) & (positionMarkers[i] # x) DO INC(i) END;
- IF i < nofPositionMarkers THEN
- WHILE (i < nofPositionMarkers - 1) DO positionMarkers[i] := positionMarkers[i+1]; INC(i) END;
- DEC(nofPositionMarkers);
- positionMarkers[nofPositionMarkers] := NIL
- END;
- IF FindScreenPos(x.pos.GetPosition(), xp, yp) THEN
- l := layout.FindLineNrByPos(x.pos.GetPosition());
- IF (l < LEN(layout.lines^)) & (l >= 0) THEN
- ascent := layout.lines[l].ascent;
- (* IF ascent = 0 THEN ascent := layout.lines[l].height END;
- IF ascent = 0 THEN ascent := 10 END; *)
- newRect := x.GetArea(xp, yp, ascent);
- InvalidateRect(newRect)
- END
- END;
- Release
- END RemovePositionMarker;
- PROCEDURE PositionMarkerChanged(sender, data : ANY);
- VAR newRect, combinedRect : WMRectangles.Rectangle; x, y, l, ascent : LONGINT;
- BEGIN
- IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.PositionMarkerChanged, sender, data)
- ELSE
- data := sender;
- IF (data # NIL) & (data IS PositionMarker) THEN
- text.AcquireRead;
- IF data = cursor THEN CheckCursor; END;
- IF (data = cursor) & (clBgCurrentLineI # 0) THEN
- Invalidate; (* HACK to handle clBgCurrentLine correcty. Should be replaced by a more efficient solution *)
- ELSE
- IF FindScreenPos(data(PositionMarker).pos.GetPosition(), x, y) THEN
- l := layout.FindLineNrByPos(data(PositionMarker).pos.GetPosition());
- IF (l < LEN(layout.lines^)) & (l >= 0) THEN
- ascent := layout.lines[l].ascent;
- (* IF ascent = 0 THEN ascent := layout.lines[l].height END;
- IF ascent = 0 THEN ascent := 10 END;*)
- newRect := data(PositionMarker).GetArea(x, y, ascent)
- END
- END;
- combinedRect := data(PositionMarker).currentArea;
- IF WMRectangles.RectEmpty(combinedRect) THEN combinedRect := newRect
- ELSE WMRectangles.ExtendRect(combinedRect, newRect)
- END;
- IF ~WMRectangles.RectEmpty(combinedRect) THEN
- IF (WMRectangles.Area(data(PositionMarker).currentArea) + WMRectangles.Area(newRect)) * 5 < WMRectangles.Area(combinedRect) THEN
- InvalidateRect(data(PositionMarker).currentArea);
- InvalidateRect(newRect)
- ELSE
- InvalidateRect(combinedRect)
- END
- END;
- END;
- text.ReleaseRead;
- ELSE
- Invalidate;
- END;
- END
- END PositionMarkerChanged;
- (* END PositionMarkers *)
- PROCEDURE CheckNumberOfLines;
- BEGIN
- UpdateScrollbars;
- firstLine.SetBounds(0, layout.GetNofLines() - 1)
- END CheckNumberOfLines;
- PROCEDURE CheckCursor;
- VAR
- cp, l, i : LONGINT;
- ty : LONGINT;
- lineStartPosition, lineLength: LONGINT;
- li: LineInfo;
- dummyCh : Char32;
- x, dummyY, xend, paperWidth, newShift: LONGINT;
- dummyBool : BOOLEAN;
- BEGIN
- ASSERT(IsCallFromSequencer() & text.HasReadLock());
- (* Scroll up, down to make cursor visible *)
- cp := cursor.GetPosition();
- IF cp = lastCursorPos THEN
- RETURN
- ELSE
- lastCursorPos := cp
- END;
- IF (cp < 0) THEN
- cursor.SetPosition(GetDisplayPos(0));
- ELSIF (cp > text.GetLength()) THEN
- cursor.SetPosition(text.GetLength());
- END;
- l := layout.FindLineNrByPos(cursor.GetPosition());
- IF (l < firstLineI) THEN
- (* move the cursor down by 3 lines to get more context *)
- l := Strings.Max(0, l - 3);
- firstLine.Set(l);
- ELSIF (l < layout.GetNofLines()) THEN
- ty := bordersI.t; i := firstLineI;
- WHILE i < l DO
- ty := ty + layout.lines[i].height;
- CheckParagraphBegin(i, ty);
- CheckParagraphEnd(i, ty);
- INC(i);
- END;
- ty := ty + layout.lines[i].height;
- IF ty >= bounds.GetHeight() - bordersI.b THEN
- l := Strings.Max(0, l - 3);
- firstLine.Set(l)
- END
- END;
- (* fof071127: Scroll left right to make cursor visible *)
- lineStartPosition := layout.GetLineStartPos(l);
- lineLength := layout.GetLineLength(l);
- (* compute x position of the cursor on the line *)
- IF optimize OR ~text.isUTF THEN
- LayoutLine(lineStartPosition,dummyCh,li,layout.paperWidth,cp,-1);
- x := li.width + GetLineLeftIndent(l);
- ELSE
- dummyBool := FindScreenPos(cp,x,dummyY);
- IF x < 0 THEN
- x := 0;
- END;
- INC(x,GetLineLeftIndent(l));
- END;
- (* compute x position of the end of the cursor's line *)
- lineStartPosition := layout.GetLineStartPos(l);
- lineLength := layout.GetLineLength(l);
- LayoutLine(lineStartPosition, dummyCh, li, layout.paperWidth, lineStartPosition+lineLength-1, -1);
- xend := li.width + GetLineLeftIndent(l);
- newShift := leftShiftI;
- (* align shift such that the cursor is visible *)
- paperWidth := layout.paperWidth - bordersI.l - x0;
- IF paperWidth > 0 THEN
- IF x-leftShiftI > paperWidth THEN (* cursor right of displayed area *)
- newShift := x-paperWidth; (* move content such that cursor is barely visible to the right *)
- ELSIF x-leftShiftI < 0 THEN (* cursor is left of displayed area *)
- newShift := x; (* move content such that cursor is barely visible to the left *)
- END;
- (* now check some possibly more optimal ways of displaying *)
- IF xend-newShift < paperWidth THEN
- (* line can be shown more fully to the left, we don't want to waste space to the right *)
- newShift := xend-paperWidth;
- IF newShift < 0 THEN newShift := 0 END;
- END;
- (* do the shift *)
- IF newShift # leftShiftI THEN
- leftShift.Set(newShift);
- END;
- END;
- END CheckCursor;
- PROCEDURE CheckParagraphBegin(lineNr : LONGINT; VAR height: LONGINT);
- BEGIN
- IF layout.lines[lineNr].firstInParagraph THEN height := height + layout.lines[lineNr].spaceBefore END
- END CheckParagraphBegin;
- PROCEDURE CheckParagraphEnd(lineNr : LONGINT; VAR height: LONGINT);
- BEGIN
- IF layout.lines[lineNr].lastInParagraph THEN height := height + layout.lines[lineNr].spaceAfter; END;
- END CheckParagraphEnd;
- PROCEDURE TextChanged(sender, data : ANY);
- VAR
- f, l, t, b, i, p, pa, pb, h: LONGINT; linesChanged, fullLayout : BOOLEAN;
- info : Texts.TextChangeInfo;
- BEGIN
- IF ~initialized THEN RETURN END;
- IF ~IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.TextChanged, sender, data)
- ELSE
- IF (data # NIL) & (data IS Texts.TextChangeInfo) & (data(Texts.TextChangeInfo).op # Texts.OpMulti) THEN
- text.AcquireRead;
- info := data(Texts.TextChangeInfo);
- IF text.GetTimestamp() = info.timestamp THEN
- info := data(Texts.TextChangeInfo);
- IF (highlighter # NIL) THEN
- ASSERT(state # NIL);
- fullLayout := FALSE;
- IF ((info.op = Texts.OpInsert) OR (info.op = Texts.OpDelete)) THEN
- highlighter.PatchRegions(info, utilreader, state, fullLayout);
- ELSIF (info.op = Texts.OpAttributes) THEN
- (* do nothing here *)
- ELSE
- highlighter.RebuildRegions(utilreader, state);
- fullLayout := TRUE;
- END;
- IF fullLayout THEN
- layout.FullLayout(TRUE);
- lastTimeStamp := text.GetTimestamp();
- CheckCursor;
- CheckNumberOfLines;
- text.ReleaseRead;
- InvalidateRect(GetClientRect());
- cursorBlinker.Show(cursor);
- RETURN;
- END;
- END;
- (* Upon an insertion or deletion in the text, parts of the text may need reformatting *)
- IF info.op = Texts.OpInsert THEN
- (* If necessary, reformat the affected text *)
- IF layout.initialized & text.isUTF & (layout.bidiFormatter # NIL) THEN
- layout.bidiFormatter.ReformatTextFrom(info.pos,info.len);
- END;
- layout.FixLayoutFrom(info.pos, info.len, f, l, linesChanged);
- ELSE
- (* If necessary, reformat the affected text *)
- IF layout.initialized & text.isUTF & (layout.bidiFormatter # NIL) THEN
- layout.bidiFormatter.ReformatTextFrom(info.pos,-info.len)
- END;
- layout.FixLayoutFrom(info.pos, -info.len, f, l, linesChanged);
- END;
- t := bordersI.t;
- FOR i := firstLineI TO f - 1 DO
- t := t + (layout.lines[i].height);
- CheckParagraphBegin(i, t);
- CheckParagraphEnd(i, t);
- END;
- h := bounds.GetHeight();
- IF linesChanged THEN b := h ELSE
- b := t; i := f;
- WHILE (i <= l) & (b < h) DO
- b := b + (layout.lines[i].height);
- CheckParagraphBegin(i, b);
- CheckParagraphEnd(i, b);
- INC(i);
- END
- END;
- pa := layout.lines[f].pos;
- IF l + 1 < layout.nofLines THEN pb := layout.lines[l + 1].pos ELSE pb := text.GetLength() END;
- FOR i := 0 TO nofPositionMarkers - 1 DO
- p := positionMarkers[i].pos.GetPosition();
- IF (p >= pa) & (p < pb) THEN
- (* very conservative *)
- h := positionMarkers[i].currentArea.b - positionMarkers[i].currentArea.t;
- t := t - h;
- b := b + h
- END
- END;
- CheckCursor;
- UpdateScrollbars;
- InvalidateRect(WMRectangles.MakeRect(0, t, bounds.GetWidth(), b));
- ELSIF (lastTimeStamp - info.timestamp) > 0 THEN
- (* Don't update lastTimeStamp since we didn't update the layout *)
- ELSE
- IF (highlighter # NIL) THEN
- ASSERT(state # NIL);
- highlighter.RebuildRegions(utilreader, state);
- END;
- layout.FullLayout(TRUE);
- lastTimeStamp := text.GetTimestamp();
- CheckCursor;
- InvalidateRect(GetClientRect())
- END;
- CheckNumberOfLines;
- text.ReleaseRead
- ELSE
- text.AcquireRead;
- IF (highlighter # NIL) THEN
- ASSERT(state # NIL);
- highlighter.RebuildRegions(utilreader, state);
- END;
- layout.FullLayout(TRUE);
- lastTimeStamp := text.GetTimestamp();
- CheckCursor;
- CheckNumberOfLines;
- text.ReleaseRead;
- InvalidateRect(GetClientRect())
- END;
- cursorBlinker.Show(cursor);
- END;
- END TextChanged;
- (* BEGIN view dependant layout functions *)
- (** Return the left indent of a line - depending on alignment *)
- (* returns left border, in case of errors *)
- PROCEDURE GetLineLeftIndent(linenr : LONGINT): LONGINT;
- VAR indent : LONGINT;
- BEGIN
- IF (linenr < 0) OR (linenr >= layout.nofLines) THEN RETURN 0 END;
- IF layout.lines[linenr].firstInParagraph THEN indent := layout.lines[linenr].firstIndent ELSE indent := layout.lines[linenr].leftIndent END;
- CASE layout.lines[linenr].align OF
- AlignLeft : RETURN indent;
- |AlignCenter : RETURN ((layout.paperWidth - (layout.lines[linenr].width)) DIV 2 - indent DIV 2);
- |AlignRight : RETURN (layout.paperWidth - layout.lines[linenr].width - layout.lines[linenr].rightIndent);
- ELSE
- RETURN 0;
- END;
- END GetLineLeftIndent;
- (** Find the line number that currently contains the y value (y relative to 0 in component)*)
- PROCEDURE FindLineByY*(firstLine, y : LONGINT) : LONGINT;
- VAR i : LONGINT; ypos : LONGINT;
- BEGIN
- ASSERT(text.HasReadLock());
- ypos := bordersI.t; i := firstLine;
- IF y < 0 THEN RETURN 0 END;
- WHILE (i < layout.nofLines) & (ypos <= y) DO
- ypos := ypos + layout.lines[i].height;
- CheckParagraphBegin(i, ypos);
- CheckParagraphEnd(i, ypos);
- INC(i);
- END;
- RETURN Strings.Max(i -1, 0)
- END FindLineByY;
- PROCEDURE ViewToTextPos*(x, y: LONGINT; VAR pos : LONGINT);
- VAR
- l : LONGINT;
- dummy : LineInfo;
- dummyCh : Char32;
- indent : LONGINT;
- BEGIN
- text.AcquireRead;
- pos := -1;
- x := Strings.Max(0, Strings.Min(x, bounds.GetWidth()));
- y := Strings.Max(0, Strings.Min(y, bounds.GetHeight()));
- l := FindLineByY(firstLineI, Strings.Min(Strings.Max(y, bordersI.t), bounds.GetHeight() - bordersI.b));
- x := x - bordersI.l - x0 + leftShiftI;
- IF x < 0 THEN x := 0 END;
- IF l >= 0 THEN
- dummy := layout.lines[l]; (* this line belongs in here! *)
- pos := layout.GetLineStartPos(l);
- IF dummy.firstInParagraph THEN indent := dummy.firstIndent
- ELSE indent := dummy.leftIndent END;
- IF dummy.align = 0 THEN (* Left *)
- LayoutLine(pos, dummyCh, dummy, layout.paperWidth, -1, x-indent)
- ELSIF dummy.align = 1 THEN (* Center *)
- LayoutLine(pos, dummyCh, dummy, layout.paperWidth, -1, x-((layout.paperWidth - dummy.width - indent) DIV 2))
- ELSIF dummy.align = 2 THEN (* Right *)
- LayoutLine(pos, dummyCh, dummy, layout.paperWidth, -1, x-(layout.paperWidth - dummy.width - dummy.rightIndent))
- END;
- (* Adjust the position if necessary *)
- IF IsRightToLeft(pos) THEN
- DEC(pos);
- END;
- END;
- text.ReleaseRead
- END ViewToTextPos;
- (* Returns the height for the given width *)
- PROCEDURE GetHeight*(width: LONGINT): LONGINT;
- VAR oldWidth, height : LONGINT;
- BEGIN
- oldWidth := layout.paperWidth;
- layout.paperWidth := width;
- layout.FullLayout(FALSE);
- height := layout.textHeight;
- (* reset old state *)
- layout.paperWidth := oldWidth;
- layout.FullLayout(FALSE);
- RETURN height
- END GetHeight;
- (* Returns the size of the largest word and line in pixels *)
- PROCEDURE GetMinMaxWidth*(VAR word, line : LONGINT);
- VAR dx, pos : LONGINT;
- cws, cls : LONGINT;
- f,cf : WMGraphics.Font;
- ch : Char32;
- tabstring : ARRAY 256 OF CHAR; tabs : CustomTabStops; tp : TabPositions;
- sr : Streams.StringReader; tabCounter, tabPos : LONGINT; token : ARRAY 16 OF CHAR;
- pStyle : Texts.ParagraphStyle;
- cStyle : Texts.CharacterStyle;
- PROCEDURE GetWidth(ch : Char32; VAR dx : LONGINT);
- VAR gs : WMGraphics.GlyphSpacings; vc : WMComponents.VisualComponent;
- BEGIN
- IF ch = Texts.ObjectChar THEN
- IF (utilreader.object # NIL) & (utilreader.object IS WMGraphics.Image) THEN
- dx := utilreader.object(WMGraphics.Image).width
- ELSIF (utilreader.object # NIL) & (utilreader.object IS WMComponents.VisualComponent) THEN
- vc := utilreader.object(WMComponents.VisualComponent);
- dx := vc.bounds.GetWidth();
- END
- ELSIF ch = Texts.TabChar THEN
- IF tabs # NIL THEN dx := tabs.GetNextTabStop(cls) - cls
- ELSE dx := defaultTabStops.GetNextTabStop(cls) - cls
- END;
- ELSE
- IF isPasswordI THEN ch := passwordChar.Get() END;
- IF f.HasChar(ch) THEN
- f.GetGlyphSpacings(ch, gs);
- ELSE
- WMGraphics.FBGetGlyphSpacings(ch, gs);
- END;
- dx := gs.bearing.l + gs.width + gs.bearing.r
- END
- END GetWidth;
- BEGIN
- cf := GetFont(); (* set the default component font *)
- f := cf;
- pos := 0; cws := 0; cls := 0; word := 0; line := 0;
- text.AcquireRead;
- utilreader.SetDirection(1); utilreader.SetPosition(pos);
- REPEAT
- utilreader.ReadCh(ch);
- (* Get the Paragraph Style *)
- IF utilreader.pstyle # NIL THEN
- pStyle := utilreader.pstyle;
- (* parse tabstops *)
- COPY(pStyle.tabStops, tabstring);
- IF (tabstring # "default") & (tabstring # "0") & (tabstring # "") THEN
- NEW(sr, LEN(tabstring)); sr.Set(tabstring); tabCounter := 0;
- WHILE (sr.res = Streams.Ok) DO
- sr.SkipWhitespace; sr.String(token);
- INC(tabCounter);
- END;
- NEW(tp, tabCounter);
- sr.Reset; tabCounter := 0;
- WHILE (sr.res = Streams.Ok) DO
- sr.SkipWhitespace; sr.String(token);
- Strings.StrToInt(token, tabPos);
- tp[tabCounter] := tabPos;
- INC(tabCounter);
- END;
- NEW(tabs, tp)
- END
- END;
- (* Get the Character Styles / Attributes *)
- IF utilreader.cstyle # NIL THEN
- cStyle := utilreader.cstyle;
- IF (cStyle.fontcache #NIL) & (cStyle.fontcache IS WMGraphics.Font) THEN
- f := cStyle.fontcache(WMGraphics.Font);
- ELSE
- f := WMGraphics.GetFont(cStyle.family, ENTIER(FP1616.FixpToFloat(cStyle.size)), cStyle.style);
- utilreader.cstyle.fontcache := f
- END;
- ELSIF utilreader.pstyle # NIL THEN
- IF pStyle.charStyle # NIL THEN
- cStyle := pStyle.charStyle;
- IF (cStyle.fontcache #NIL) &
- (cStyle.fontcache IS WMGraphics.Font) THEN
- f := cStyle.fontcache(WMGraphics.Font);
- ELSE
- f := WMGraphics.GetFont(cStyle.family, ENTIER(FP1616.FixpToFloat(cStyle.size)), cStyle.style);
- utilreader.pstyle.charStyle.fontcache := f
- END
- END;
- ELSIF utilreader.attributes # NIL THEN
- IF utilreader.attributes.fontInfo # NIL THEN
- IF (utilreader.attributes.fontInfo.fontcache # NIL)
- & (utilreader.attributes.fontInfo.fontcache IS WMGraphics.Font) THEN
- f := utilreader.attributes.fontInfo.fontcache(WMGraphics.Font);
- ELSE
- f := GetFontFromAttr(utilreader.attributes.fontInfo);
- utilreader.attributes.fontInfo.fontcache := f
- END
- ELSE f := cf
- END
- ELSE f := cf;
- END;
- INC(pos);
- GetWidth(ch, dx);
- IF (ch = Texts.ObjectChar) THEN
- word := Strings.Max(word, dx);
- cls := cls + dx;
- cws := 0
- ELSIF (ch = Texts.NewLineChar) THEN
- line := Strings.Max(line, cls);
- cls := 0
- ELSIF (ch = 32) THEN
- word := Strings.Max(word, cws);
- cws := 0
- ELSE
- cws := cws + dx;
- cls := cls + dx;
- END;
- UNTIL utilreader.eot;
- line := Strings.Max(line, cls);
- word := Strings.Max(word, cws);
- text.ReleaseRead;
- END GetMinMaxWidth;
- (* END view dependant layout functions *)
- PROCEDURE LineYPos(lineNr : LONGINT; VAR y0, y1 : LONGINT);
- VAR i : LONGINT;
- BEGIN
- IF (lineNr >= firstLineI) & (lineNr < layout.GetNofLines()) THEN
- y0 := bordersI.t; i := firstLineI;
- WHILE i < lineNr DO
- y0 := y0 + layout.lines[i].height;
- CheckParagraphBegin(i, y0);
- CheckParagraphEnd(i, y0);
- INC(i);
- END;
- y1 := y0 + layout.lines[i].height;
- CheckParagraphBegin(i, y1);
- ELSE y0 := 0; y1 := 0
- END
- END LineYPos;
- PROCEDURE FindScreenPos*(pos : LONGINT; VAR x, y : LONGINT) : BOOLEAN;
- VAR
- l, i, startPos, intPos: LONGINT;
- ty : LONGINT;
- li : LineInfo;
- thisCh, lastCh : Char32;
- lastLine : BOOLEAN;
- f : WMGraphics.Font;
- gs: WMGraphics.GlyphSpacings;
- BEGIN
- text.AcquireRead;
- lastLine := FALSE;
- IF (pos = text.GetLength()) THEN
- utilreader.SetDirection(1); utilreader.SetPosition(text.GetLength() - 1);
- utilreader.ReadCh(thisCh);
- IF thisCh = Texts.NewLineChar THEN lastLine := TRUE END
- END;
- IF lastLine THEN
- ty := bordersI.t; i := firstLineI;
- WHILE i < layout.nofLines DO
- ty := ty + layout.lines[i].height;
- CheckParagraphBegin(i, ty);
- CheckParagraphEnd(i, ty);
- INC(i);
- END;
- IF i > 0 THEN
- y := (ty + layout.lines[i - 1].ascent)
- ELSE
- f := GetFont();
- y := (ty + f.GetAscent());
- END;
- x := bordersI.l + x0 - leftShiftI;
- text.ReleaseRead;
- RETURN TRUE
- ELSIF (pos = 0) & (firstLineI = 0) THEN
- ty := bordersI.t;
- IF layout.GetNofLines() > 0 THEN
- y := (ty + layout.lines[0].ascent);
- ELSE
- f := GetFont();
- y := ty+f.GetAscent();
- END;
- CheckParagraphBegin(0, y);
- x := bordersI.l + x0 - leftShiftI;
- text.ReleaseRead;
- RETURN TRUE
- ELSE
- l := layout.FindLineNrByPos(pos);
- IF (l >= firstLineI) & (l < layout.GetNofLines()) THEN
- ty := bordersI.t; i := firstLineI;
- WHILE i < l DO
- ty := ty + layout.lines[i].height;
- CheckParagraphBegin(i, ty);
- CheckParagraphEnd(i, ty);
- INC(i);
- END;
- y := (ty + layout.lines[i].ascent);
- CheckParagraphBegin(i, y);
- startPos := layout.GetLineStartPos(i);
- f := GetFont();
- intPos := GetInternalPos(pos);
- utilreader.SetPosition(intPos-1);
- utilreader.ReadCh(lastCh);
- utilreader.ReadCh(thisCh);
- (* if this character is rtl and its predecessor is ltr, move the position to the right of the previous character *)
- IF (intPos # 0) & (IsRightToLeft(intPos) & ~IsRightToLeft(intPos-1) & (intPos # startPos)) OR
- ((~IsRightToLeft(intPos) OR (thisCh = 0AH)) & ~IsRightToLeft(intPos-1) & ODD(GetParagraphEmbeddingLevel(pos))) THEN
- LayoutLine(startPos, lastCh, li, layout.paperWidth, GetDisplayPos(intPos-1), -1);
- IF f.HasChar(lastCh) THEN
- f.GetGlyphSpacings(lastCh, gs);
- ELSE
- WMGraphics.FBGetGlyphSpacings(lastCh, gs);
- END;
- x := li.width + GetLineLeftIndent(l) + bordersI.l + x0 - leftShiftI + gs.bearing.l + gs.width + gs.bearing.r;
- ELSIF (intPos # 0) & ((thisCh = 0AH) OR (thisCh = 0H)) & IsRightToLeft(intPos-1) THEN
- LayoutLine(startPos, thisCh, li, layout.paperWidth, GetDisplayPos(intPos-1), -1);
- x := (li.width + GetLineLeftIndent(l) + bordersI.l + x0 - leftShiftI);
- (* if this and its predecessor are rtl, move the position to the right of this character *)
- ELSIF IsRightToLeft(intPos) THEN
- LayoutLine(startPos, thisCh, li, layout.paperWidth, pos, -1);
- IF f.HasChar(thisCh) THEN
- f.GetGlyphSpacings(thisCh, gs);
- ELSE
- WMGraphics.FBGetGlyphSpacings(thisCh, gs);
- END;
- x := li.width + GetLineLeftIndent(l) + bordersI.l + x0 - leftShiftI + gs.bearing.l + gs.width + gs.bearing.r;
- (* if this character is ltr and its predecessor is rtl move the position to the left of the predecessor *)
- ELSIF (intPos # 0) & (~IsRightToLeft(intPos) OR (thisCh = 0AH)) & IsRightToLeft(intPos-1) THEN
- LayoutLine(startPos, thisCh, li, layout.paperWidth, GetDisplayPos(intPos-1), -1);
- x := (li.width + GetLineLeftIndent(l) + bordersI.l + x0 - leftShiftI);
- (* if this and the previous character are ltr, leave the position at the left of this character *)
- ELSE
- LayoutLine(startPos, thisCh, li, layout.paperWidth, pos, -1);
- x := (li.width + GetLineLeftIndent(l) + bordersI.l + x0 - leftShiftI);
- END;
- text.ReleaseRead;
- RETURN TRUE
- ELSE
- text.ReleaseRead;
- RETURN FALSE
- END
- END
- END FindScreenPos;
- (* Get the internal position for a given display position. *)
- PROCEDURE GetInternalPos*(pos : LONGINT) : LONGINT;
- VAR
- lineNr, startPos, lineLength : LONGINT;
- dummyTextReader : Texts.TextReader;
- BEGIN
- (* if the text is non-utf formatted, the internal position and the display position are the same *)
- IF ~text.isUTF OR (layout.bidiFormatter = NIL) THEN
- RETURN pos;
- END;
- text.AcquireRead;
- lineNr := layout.FindLineNrByPos(pos);
- startPos := layout.GetLineStartPos(lineNr);
- lineLength := layout.GetLineLength(lineNr);
- dummyTextReader := layout.bidiFormatter.ReorderLine(startPos,lineLength);
- text.ReleaseRead;
- RETURN layout.bidiFormatter.GetInternalPosition(pos,startPos);
- END GetInternalPos;
- (* Get the display position for a given display position. *)
- PROCEDURE GetDisplayPos*(pos : LONGINT) : LONGINT;
- VAR
- lineNr, startPos, lineLength : LONGINT;
- dummyTextReader : Texts.TextReader;
- BEGIN
- (* if the text is non-utf formatted, the internal position and the display position are the same *)
- IF ~text.isUTF OR (layout.bidiFormatter = NIL) THEN
- RETURN pos;
- END;
- lineNr := layout.FindLineNrByPos(pos);
- startPos := layout.GetLineStartPos(lineNr);
- lineLength := layout.GetLineLength(lineNr);
- dummyTextReader := layout.bidiFormatter.ReorderLine(startPos,lineLength);
- RETURN layout.bidiFormatter.GetDisplayPosition(pos,startPos);
- END GetDisplayPos;
- (* Checks if the current position is in an rtl context *)
- PROCEDURE IsRightToLeft*(pos : LONGINT) : BOOLEAN;
- VAR
- lineNr, startPos, lineLength : LONGINT;
- dummyTextReader : Texts.TextReader;
- BEGIN
- IF ~text.isUTF OR (layout.bidiFormatter = NIL) THEN
- RETURN FALSE;
- END;
- lineNr := layout.FindLineNrByPos(pos);
- startPos := layout.GetLineStartPos(lineNr);
- lineLength := layout.GetLineLength(lineNr);
- IF layout.initialized THEN
- dummyTextReader := layout.bidiFormatter.ReorderLine(startPos,lineLength);
- END;
- RETURN ODD(layout.bidiFormatter.GetImplicitLevel(pos));
- END IsRightToLeft;
- (* Gets the paragraph embedding level of the current position's line *)
- PROCEDURE GetParagraphEmbeddingLevel*(pos : LONGINT) : LONGINT;
- BEGIN
- IF ~text.isUTF OR (layout.bidiFormatter = NIL) THEN
- RETURN 0;
- END;
- RETURN layout.bidiFormatter.GetParagraphEmbeddingLevel(pos);
- END GetParagraphEmbeddingLevel;
- PROCEDURE LayoutLine(VAR pos : LONGINT; VAR ch : Char32; VAR l : LineInfo; wrapwidth, stopPos, stopXPos : LONGINT);
- VAR
- i, wrapPos : LONGINT;
- eol, first : BOOLEAN;
- ascent, descent, leading, ld, a, d, dx, x : LONGINT;
- align, firstIndent, leftIndent, rightIndent, spaceBefore, spaceAfter : LONGINT;
- tabstring : ARRAY 256 OF CHAR; tabs : CustomTabStops; tp : TabPositions;
- sr : Streams.StringReader; tabCounter, tabPos : LONGINT; token : ARRAY 16 OF CHAR;
- pStyle : Texts.ParagraphStyle;
- start, stop, isFirst : BOOLEAN;
- bidiTextReader, localTextReader : Texts.TextReader;
- regionStart, regionEnd,lastEnd : LONGINT;
- readerPosition : LONGINT;
- highlighterStyle, lastHighlighterStyle : SyntaxHighlighter.Style;
- currentStyle, lastStyle : ANY;
- cf: WMGraphics.Font;
- style : RECORD
- voff : LONGINT;
- font : WMGraphics.Font;
- END;
- PROCEDURE GetExtents(ch : Char32; VAR dx, ascent, descent: LONGINT);
- VAR gs : WMGraphics.GlyphSpacings; vc : WMComponents.VisualComponent; font : WMGraphics.Font;
- BEGIN
- IF ch = Texts.ObjectChar THEN
- IF (localTextReader.object # NIL) & (localTextReader.object IS WMGraphics.Image) THEN
- ascent := localTextReader.object(WMGraphics.Image).height - style.voff;
- descent := style.voff;
- dx := localTextReader.object(WMGraphics.Image).width
- ELSIF (localTextReader.object # NIL) & (localTextReader.object IS WMComponents.VisualComponent) THEN
- vc := localTextReader.object(WMComponents.VisualComponent);
- dx := vc.bounds.GetWidth();
- ascent := vc.bounds.GetHeight() - style.voff;
- descent := style.voff;
- (* Add a Sequencer to the object if none exists *)
-
- IF (vc.sequencer = NIL) OR (vc.sequencer # sequencer) THEN
- vc.SetSequencer(sequencer);
- IF sequencer#NIL THEN vc.Reset(NIL, NIL); END;
- END;
- END
- ELSIF ch = Texts.TabChar THEN
- IF l.tabStops # NIL THEN dx := l.tabStops.GetNextTabStop(x) - x
- ELSE dx := defaultTabStops.GetNextTabStop(x) - x
- END;
- ascent := style.font.GetAscent() - style.voff;
- descent := style.font.GetDescent() + style.voff
- ELSIF ch = Texts.LabelChar THEN
- IF showLabels.Get() THEN
- font := cf;
- font.GetStringSize(localTextReader.object(Texts.LabelPiece).label^, dx, ascent);
- INC(dx, 4);
- ELSE
- ascent := 0; descent := 0;
- dx := 0;
- END;
- ELSE
- IF isPasswordI THEN ch := passwordChar.Get() END;
- IF style.font.HasChar(ch) THEN
- style.font.GetGlyphSpacings(ch, gs);
- ELSE
- WMGraphics.FBGetGlyphSpacings(ch, gs);
- END;
- ascent := gs.ascent - style.voff;
- descent := gs.descent + style.voff;
- dx := gs.bearing.l + gs.width + gs.bearing.r
- END
- END GetExtents;
- BEGIN
- style.voff := 0;
- cf := GetFont();
- style.font := cf;
- x := 0; l.pos := pos; l.height := style.font.GetHeight();
- (* For layouting a reordered line, the reordered text is needed, to correctly measure
- the extends of each character. *)
- IF text.isUTF & (layout.bidiFormatter # NIL) THEN
- isFirst := FALSE;
- bidiTextReader := layout.bidiFormatter.ReadyTextReader(pos,isFirst);
- END;
- (* if a reformatted text is available initialize it correpsondingly *)
- IF (bidiTextReader # NIL) THEN
- (* if a reordered line is available, the contextual dependency rules are applied *)
- bidiTextReader.CloneProperties(utilreader);
- localTextReader := bidiTextReader;
- localTextReader.text.AcquireRead;
- localTextReader.SetPosition(0);
- (* or initialize to default otherwise *)
- ELSE
- localTextReader := utilreader;
- localTextReader.SetPosition(pos);
- END;
- localTextReader.SetDirection(1); first := TRUE;
- (* the bidi formatter needs special treatment when finding out about the first line of the paragraph *)
- start := FALSE; stop := FALSE;
- IF (pos = 0) THEN start := TRUE;
- ELSIF (bidiTextReader = NIL) THEN
- localTextReader.SetPosition(pos-1);
- localTextReader.ReadCh(ch);
- IF (ch = Texts.NewLineChar) THEN start := TRUE;
- ELSE start := FALSE;
- END;
- ELSE (* bidiTextReader # NIL *)
- IF isFirst THEN
- start := TRUE;
- ELSE
- start := FALSE;
- END;
- END;
- i := 0; leading := 0; ascent := style.font.GetAscent(); descent := style.font.GetDescent();
- align := AlignLeft; l.tabStops := NIL; COPY("", tabstring);
- firstIndent := 0; leftIndent := 0; rightIndent := 0; spaceBefore := 0; spaceAfter := 0;
- lastEnd := -1;
- highlighterStyle := NIL; lastHighlighterStyle := NIL;
- currentStyle := NIL; lastStyle := NIL;
- eol := FALSE;
- REPEAT
- readerPosition := localTextReader.GetPosition();
- localTextReader.ReadCh(ch);
- IF (highlighter # NIL) THEN
- ASSERT(state # NIL);
- IF (lastEnd < readerPosition) THEN
- highlighterStyle := highlighter.GetRegionStyle(readerPosition, state, regionStart, regionEnd);
- IF (highlighterStyle # NIL) THEN
- lastEnd := regionEnd;
- ELSE
- IF (ch > 32) THEN
- highlighterStyle := highlighter.GetWordStyle(localTextReader, readerPosition, lastEnd);
- END;
- END;
- localTextReader.SetPosition(readerPosition);
- localTextReader.ReadCh(ch); (* restore text reader state *)
- END;
- IF (highlighterStyle = NIL) THEN
- highlighterStyle := highlighter.GetDefaultStyle();
- END;
- END;
- (* Get the Paragraph Style *)
- IF localTextReader.pstyle # NIL THEN
- pStyle := localTextReader.pstyle;
- (* pStyle := Texts.GetParagraphStyleByName(pStyle.name); *)
- spaceBefore := ENTIER(FP1616.FixpToFloat(pStyle.spaceBefore));
- spaceAfter := ENTIER(FP1616.FixpToFloat(pStyle.spaceAfter));
- firstIndent := ENTIER(FP1616.FixpToFloat(pStyle.firstIndent));
- leftIndent := ENTIER(FP1616.FixpToFloat(pStyle.leftIndent));
- rightIndent := ENTIER(FP1616.FixpToFloat(pStyle.rightIndent));
- align := pStyle.alignment;
- (* parse tabstops *)
- COPY(pStyle.tabStops, tabstring);
- IF (tabstring # "default") & (tabstring # "0") & (tabstring # "") THEN
- NEW(sr, LEN(tabstring)); sr.Set(tabstring); tabCounter := 0;
- WHILE (sr.res = Streams.Ok) DO
- sr.SkipWhitespace; sr.String(token);
- INC(tabCounter);
- END;
- NEW(tp, tabCounter);
- sr.Reset; tabCounter := 0;
- WHILE (sr.res = Streams.Ok) DO
- sr.SkipWhitespace; sr.String(token);
- Strings.StrToInt(token, tabPos);
- tp[tabCounter] := tabPos;
- INC(tabCounter);
- END;
- NEW(tabs, tp);
- IF l.tabStops = NIL THEN l.tabStops := tabs END
- END;
- END;
- IF (highlighterStyle = NIL) OR (highlighterStyle.defined * SyntaxHighlighter.DefineMask # SyntaxHighlighter.DefineMask) THEN
- IF localTextReader.cstyle # NIL THEN
- IF (currentStyle # localTextReader.cstyle) THEN
- currentStyle := localTextReader.cstyle;
- style.voff := ENTIER(FP1616.FixpToFloat(localTextReader.cstyle.baselineShift));
- ld := ENTIER(FP1616.FixpToFloat(localTextReader.cstyle.leading));
- IF (localTextReader.cstyle.fontcache #NIL) & (localTextReader.cstyle.fontcache IS WMGraphics.Font) THEN
- style.font := localTextReader.cstyle.fontcache(WMGraphics.Font);
- ELSE
- style.font := WMGraphics.GetFont(localTextReader.cstyle.family, ENTIER(FP1616.FixpToFloat(localTextReader.cstyle.size)), localTextReader.cstyle.style);
- localTextReader.cstyle.fontcache := style.font;
- END;
- END;
- ELSIF localTextReader.pstyle # NIL THEN
- IF pStyle.charStyle # NIL THEN
- style.voff := ENTIER(FP1616.FixpToFloat(localTextReader.cstyle.baselineShift));
- ld := ENTIER(FP1616.FixpToFloat(localTextReader.cstyle.leading));
- IF (localTextReader.cstyle.fontcache #NIL) & (localTextReader.cstyle.fontcache IS WMGraphics.Font) THEN
- style.font := localTextReader.cstyle.fontcache(WMGraphics.Font);
- ELSE
- style.font := WMGraphics.GetFont(localTextReader.cstyle.family, ENTIER(FP1616.FixpToFloat(localTextReader.cstyle.size)), localTextReader.cstyle.style);
- localTextReader.pstyle.charStyle.fontcache := style.font
- END
- END;
- ELSIF localTextReader.attributes # NIL THEN
- IF (currentStyle # localTextReader.attributes) THEN
- currentStyle := localTextReader.attributes;
- style.voff := localTextReader.attributes.voff;
- ld := 0;
- IF localTextReader.attributes.fontInfo # NIL THEN
- IF (localTextReader.attributes.fontInfo.fontcache # NIL) & (localTextReader.attributes.fontInfo.fontcache IS WMGraphics.Font) THEN
- style.font := localTextReader.attributes.fontInfo.fontcache(WMGraphics.Font);
- ELSE
- style.font := GetFontFromAttr(localTextReader.attributes.fontInfo);
- localTextReader.attributes.fontInfo.fontcache := style.font;
- END
- ELSE
- style.font := cf
- END
- END;
- ELSE
- IF (currentStyle # DefaultStyle) THEN
- currentStyle := DefaultStyle;
- style.voff := 0;
- style.font := cf;
- ld := 0;
- END;
- END;
- ASSERT(style.font # NIL);
- END;
- IF (highlighterStyle # NIL) THEN
- IF (highlighterStyle # lastHighlighterStyle) OR (currentStyle # lastStyle) THEN
- IF SyntaxHighlighter.Voff IN highlighterStyle.defined THEN style.voff := highlighterStyle.attributes.voff; END;
- IF (SyntaxHighlighter.FontMask * highlighterStyle.defined # {}) THEN
- CheckFont(highlighterStyle, style.font, fontCache);
- style.font := highlighterStyle.attributes.fontInfo.fontcache (WMGraphics.Font);
- END;
- END;
- currentStyle := NIL;
- END;
- lastStyle := currentStyle;
- lastHighlighterStyle := highlighterStyle;
- IF first THEN
- IF (ch = Texts.NewLineChar) OR (ch = 0) THEN
- ascent := style.font.GetAscent(); descent := style.font.GetDescent();
- ELSE
- descent := 0; ascent := 0;
- END;
- IF start THEN wrapwidth := wrapwidth - firstIndent - rightIndent;
- ELSE wrapwidth := wrapwidth - leftIndent - rightIndent;
- END;
- first := FALSE;
- END;
- INC(pos);
- IF (stopPos < 0) OR (pos <= stopPos) THEN
- IF (ch # Texts.NewLineChar) & (ch # 0) THEN
- GetExtents(ch, dx, a, d); ascent := Strings.Max(ascent, a); descent := Strings.Max(descent, d);
- IF ld = 0 THEN ld := ascent + descent; ELSE ld := Strings.Max(ld, ascent + descent); END; leading := Strings.Max(leading, ld);
- IF isMultiLineI & (wrapModeI # NoWrap) & (i > 0) & (x0 + x + dx > wrapwidth) THEN
- eol := TRUE; DEC(pos); wrapPos := pos;
- (* Go left for last space *)
- IF wrapModeI = WrapWord THEN
- pos := TextUtilities.FindPosWordLeft(localTextReader, pos);
- IF pos <= l.pos THEN pos := wrapPos (* no word break found. wrap at latest possible pos *)
- ELSE (* decrease width to actual size.. *)
- (* localTextReader.SetPosition(pos);
- WHILE pos < wrapPos DO
- localTextReader.ReadCh(ch); GetExtents(ch, dx, a, d); x := x - dx; INC(pos)
- END
- *) END
- END
- ELSE
- IF (stopXPos >= 0) & (x + dx DIV 2 > stopXPos) THEN
- DEC(pos);
- (* the bidi formatted text's lock needs to be released explicitly *)
- IF (bidiTextReader # NIL) THEN
- localTextReader.text.ReleaseRead;
- END;
- RETURN
- END;
- INC(x, dx)
- END;
- ELSE
- eol := TRUE;
- stop := TRUE;
- IF (stopXPos >= 0) THEN DEC(pos) END;
- END;
- ELSE
- eol := TRUE
- END;
- INC(i);
- UNTIL eol OR localTextReader.eot;
- l.width := x;
- l.ascent := ascent; l.height := leading; (* ascent + descent; *)
- l.align := align; l.leftIndent := leftIndent; l.rightIndent := rightIndent;
- IF l.height = 0 THEN l.height := style.font.GetHeight() END;
- IF start THEN l.firstInParagraph := TRUE; l.firstIndent := firstIndent; l.spaceBefore := spaceBefore;
- ELSE l.firstInParagraph := FALSE; END;
- IF stop THEN l.lastInParagraph := TRUE; l.spaceAfter := spaceAfter;
- ELSE l.lastInParagraph := FALSE END;
- (* the bidi formatted text's lock needs to be released explicitly *)
- IF (bidiTextReader # NIL) THEN
- localTextReader.text.ReleaseRead;
- END;
- END LayoutLine;
- (* llen = -1 to render until the end of line > 0 to render llen elements in the line *)
- PROCEDURE RenderLine*(canvas : WMGraphics.Canvas; VAR l : LineInfo; linenr, top, llen : LONGINT);
- VAR sx, dx, dy, x, sp, i, j, k, t, tx, linelength, w, p : LONGINT; char : Char32; gs: WMGraphics.GlyphSpacings;
- font : WMGraphics.Font;
- vc : WMComponents.VisualComponent;
- hc : BOOLEAN;
- bidiTextReader, localTextReader : Texts.TextReader;
- cursorPosition : LONGINT;
- regionStart, regionEnd, lastEnd: LONGINT;
- readerPosition : LONGINT;
- lineNumberString : ARRAY 16 OF CHAR;
- canvasState : WMGraphics.CanvasState;
- cliprect, temp : WMRectangles.Rectangle;
- highlighterStyle, lastHighlighterStyle : SyntaxHighlighter.Style;
- currentStyle, lastStyle : ANY;
- lastColor : LONGINT;
- cf: WMGraphics.Font;
- style : RECORD
- color, bgColor, voff : LONGINT;
- font : WMGraphics.Font;
- END;
- BEGIN
- IF TraceRenderOptimize IN Trace THEN
- KernelLog.String("RenderLine : "); KernelLog.Int(linenr, 5); KernelLog.String(" from position : ");
- KernelLog.Int(layout.GetLineStartPos(linenr), 5); KernelLog.Ln;
- END;
- sp := l.pos;
- IF sp >= text.GetLength() THEN RETURN END;
- style.color := defaultTextColorI;
- canvas.SetColor(style.color); lastColor := style.color;
- style.bgColor := defaultTextBgColorI;
- style.voff := 0;
- cf := GetFont();
- style.font := cf;
- IF llen < 0 THEN
- linelength := layout.GetLineLength(linenr);
- (* hack for the bidi formatter *)
- IF linenr = layout.GetNofLines() - 1 THEN
- DEC(linelength);
- END;
- ELSE
- linelength := llen
- END;
- (* if there is a bidi formatter, reorder the current line *)
- IF text.isUTF & (layout.bidiFormatter # NIL) THEN
- bidiTextReader := layout.bidiFormatter.ReorderLine(sp,linelength);
- END;
- (* the bidi text reader needs special treatment for the initialization *)
- IF (bidiTextReader # NIL) THEN
- (* after reordering the line, contextual dependency rules are applied *)
- bidiTextReader := ContextualDependency.AnalyzeLine(bidiTextReader,-1,-1);
- layout.bidiFormatter.SetReadyTextReader(sp,bidiTextReader);
- bidiTextReader.CloneProperties(utilreader);
- localTextReader := bidiTextReader;
- localTextReader.text.AcquireRead;
- localTextReader.SetPosition(0);
- ELSE
- (* revert the hack for the bidi formatter *)
- IF (llen < 0) & (linenr = layout.GetNofLines() - 1) THEN
- INC(linelength);
- END;
- localTextReader := utilreader;
- localTextReader.text.AcquireRead;
- localTextReader.SetPosition(sp);
- END;
- i := 0;
- x := GetLineLeftIndent(linenr);
- sx := - leftShiftI + bordersI.l + x0;
- IF TraceBaseLine IN Trace THEN
- canvas.Line(0, top + (l.ascent), bounds.GetWidth(), top + (l.ascent), 01F0000FFH, WMGraphics.ModeCopy)
- END;
- selection.Sort;
- IF (cursor.visible) & (selection.b - selection.a <= 0) & (clBgCurrentLineI # 0) THEN
- cursorPosition := cursor.GetPosition();
- IF (l.pos <= cursorPosition) & (cursorPosition < l.pos + linelength) THEN
- canvas.Fill(WMRectangles.MakeRect(0, top, bounds.GetWidth() - bordersI.r, top + l.height), clBgCurrentLineI, WMGraphics.ModeSrcOverDst);
- END;
- END;
- IF showLineNumbersI THEN
- canvas.SaveState(canvasState);
- Strings.IntToStr(linenr + 1, lineNumberString);
- temp := WMRectangles.MakeRect(bordersI.l, top, x0 - 1, top + l.height);
- IF (lineNumberBgColorI # 0) THEN
- canvas.Fill(temp, lineNumberBgColorI, WMGraphics.ModeSrcOverDst);
- END;
- temp.r := temp.r - 4;
- IF ((linenr + 1) MOD 10 = 0) THEN
- canvas.SetFont(lineNumberFont10);
- ELSE
- canvas.SetFont(lineNumberFont);
- END;
- canvas.SetColor(lineNumberColorI);
- WMGraphics.DrawStringInRect(canvas, temp, FALSE, WMGraphics.AlignRight, WMGraphics.AlignCenter, lineNumberString);
- canvas.RestoreState(canvasState); (* restore font and font color *)
- canvas.SaveState(canvasState);
- canvas.GetClipRect(cliprect);
- cliprect.l := x0;
- canvas.SetClipRect(cliprect);
- END;
- w := bounds.GetWidth() - bordersI.r;
- localTextReader.SetDirection(1);
- lastEnd := -1;
- highlighterStyle := NIL; lastHighlighterStyle := NIL;
- currentStyle := DefaultStyle; lastStyle := NIL;
- REPEAT
- readerPosition := localTextReader.GetPosition();
- localTextReader.ReadCh(char);
- IF (highlighter # NIL) THEN
- ASSERT(state # NIL);
- IF (lastEnd < readerPosition) THEN
- highlighterStyle := highlighter.GetRegionStyle(readerPosition, state, regionStart, regionEnd);
- IF (highlighterStyle # NIL) THEN
- lastEnd := regionEnd;
- ELSE
- IF (char > 32) THEN
- highlighterStyle := highlighter.GetWordStyle(localTextReader, readerPosition, lastEnd);
- END;
- END;
- localTextReader.SetPosition(readerPosition);
- localTextReader.ReadCh(char); (* restore text reader state *)
- END;
- IF (highlighterStyle = NIL) THEN
- highlighterStyle := highlighter.GetDefaultStyle();
- END;
- END;
- IF (highlighterStyle = NIL) OR (highlighterStyle.defined * SyntaxHighlighter.DefineMask # SyntaxHighlighter.DefineMask) THEN
- IF (localTextReader.cstyle # NIL) THEN
- IF (currentStyle # localTextReader.cstyle) THEN
- currentStyle := localTextReader.cstyle;
- style.color := localTextReader.cstyle.color;
- style.bgColor := localTextReader.cstyle.bgColor;
- style.voff := localTextReader.cstyle.baselineShift;
- IF (localTextReader.cstyle.fontcache # NIL) & (localTextReader.cstyle.fontcache IS WMGraphics.Font) THEN
- style.font := localTextReader.cstyle.fontcache(WMGraphics.Font);
- ELSE
- style.font := WMGraphics.GetFont(localTextReader.cstyle.family, ENTIER(FP1616.FixpToFloat(localTextReader.cstyle.size)), localTextReader.cstyle.style);
- localTextReader.cstyle.fontcache := style.font;
- END;
- END;
- ELSIF (localTextReader.attributes # NIL) THEN
- IF (currentStyle # localTextReader.attributes) THEN
- currentStyle := localTextReader.attributes;
- style.color := localTextReader.attributes.color;
- style.bgColor := localTextReader.attributes.bgcolor;
- style.voff := localTextReader.attributes.voff;
- IF (localTextReader.attributes.fontInfo # NIL) THEN
- IF (localTextReader.attributes.fontInfo.fontcache # NIL) & (localTextReader.attributes.fontInfo.fontcache IS WMGraphics.Font) THEN
- style.font := localTextReader.attributes.fontInfo.fontcache (WMGraphics.Font);
- ELSE
- style.font := GetFontFromAttr(localTextReader.attributes.fontInfo);
- localTextReader.attributes.fontInfo.fontcache := style.font;
- END;
- ELSE
- style.font := cf;
- END;
- END;
- ELSE
- IF (currentStyle # DefaultStyle) THEN
- currentStyle := DefaultStyle;
- style.color := defaultTextColorI;
- style.bgColor := defaultTextBgColorI;
- style.voff := 0;
- style.font := cf;
- END;
- END;
- ASSERT(style.font # NIL);
- END;
- IF (highlighterStyle # NIL) THEN
- IF (highlighterStyle # lastHighlighterStyle) OR (currentStyle # lastStyle) THEN
- IF SyntaxHighlighter.Voff IN highlighterStyle.defined THEN style.voff := highlighterStyle.attributes.voff; END;
- IF SyntaxHighlighter.Color IN highlighterStyle.defined THEN style.color := highlighterStyle.attributes.color; END;
- IF SyntaxHighlighter.BgColor IN highlighterStyle.defined THEN style.bgColor := highlighterStyle.attributes.bgcolor; END;
- IF (SyntaxHighlighter.FontMask * highlighterStyle.defined # {}) THEN
- CheckFont(highlighterStyle, style.font, fontCache);
- style.font := highlighterStyle.attributes.fontInfo.fontcache (WMGraphics.Font);
- END;
- END;
- currentStyle := NIL; (* force reevaluation of localTextReader style *)
- END;
- lastStyle := currentStyle;
- lastHighlighterStyle := highlighterStyle;
- IF (style.color # lastColor) THEN canvas.SetColor(style.color); lastColor := style.color; END;
- IF char = Texts.ObjectChar THEN
- IF (localTextReader.object # NIL) & (localTextReader.object IS WMGraphics.Image) THEN
- canvas.DrawImage(x, top + (l.ascent) + style.voff - localTextReader.object(WMGraphics.Image).height, localTextReader.object(WMGraphics.Image),
- WMGraphics.ModeSrcOverDst);
- dx := localTextReader.object(WMGraphics.Image).width
- ELSIF (localTextReader.object # NIL) & (localTextReader.object IS WMComponents.VisualComponent) THEN
- vc := localTextReader.object(WMComponents.VisualComponent);
- dx := vc.bounds.GetWidth();
- dy := vc.bounds.GetHeight();
- canvas.SaveState(clipState); (* save the current clip-state *)
- canvas.SetClipRect(WMRectangles.MakeRect(x + sx, top + (l.ascent - dy), x + dx + sx, top + (l.height)));
- canvas.ClipRectAsNewLimits(x + sx, top + (l.ascent - dy));
- (* assuming the component will not delay --> otherwise a buffer is needed *)
- vc.Acquire; vc.Draw(canvas); vc.Release;
- canvas.RestoreState(clipState)
- END
- ELSIF char = 0 THEN (* EOT *)
- ELSIF char = Texts.TabChar THEN
- tx := x;
- IF l.firstInParagraph THEN tx := tx - l.firstIndent
- ELSE tx := tx - l.leftIndent END;
- IF l.tabStops # NIL THEN dx := l.tabStops.GetNextTabStop(tx) - tx
- ELSE dx := defaultTabStops.GetNextTabStop(tx) - tx
- END;
- IF style.bgColor # 0 THEN
- canvas.Fill(WMRectangles.MakeRect(x + sx, top, x + dx + sx, top + (l.height)), style.bgColor, WMGraphics.ModeSrcOverDst)
- END;
- IF indicateTabsI THEN canvas.SetPixel(x + sx + ((dx + 1) DIV 2), top + ((l.ascent + 1) DIV 2), WMGraphics.Blue, WMGraphics.ModeCopy); END;
- ELSIF char = Texts.LabelChar THEN
- IF showLabels.Get() THEN
- font := cf;
- font.GetStringSize(localTextReader.object(Texts.LabelPiece).label^, dx, dy);
- font.RenderString(canvas, x + sx+2, top + (l.ascent), localTextReader.object(Texts.LabelPiece).label^);
- INC(dx, 4);
- canvas.Fill(WMRectangles.MakeRect(x + sx, top, x + dx + sx, top + (l.height)), LONGINT(0FF880050H), WMGraphics.ModeSrcOverDst);
- WMGraphicUtilities.RectGlassShade(canvas, WMRectangles.MakeRect(x + sx, top, x + dx + sx, top + (l.height)), 1, FALSE)
- ELSE dx := 0; END;
- ELSE
- IF char = Texts.NewLineChar THEN
- localTextReader.text.ReleaseRead;
- IF showLineNumbersI THEN canvas.RestoreState(canvasState); END;
- RETURN
- END;
- IF isPasswordI THEN
- char := passwordChar.Get()
- END;
- (* If the text is utf-formatted get the display version of the character.
- Note, that only some special invisible characters differ from their actual representation. *)
- IF text.isUTF THEN
- UnicodeBidirectionality.GetDisplayCharacter(char);
- END;
- hc := style.font.HasChar(char);
- IF hc THEN style.font.GetGlyphSpacings(char, gs)
- ELSE WMGraphics.FBGetGlyphSpacings(char, gs)
- END;
- dx := gs.bearing.l + gs.width + gs.bearing.r;
- IF style.bgColor MOD 256 # 0 THEN
- canvas.Fill(WMRectangles.MakeRect(x + sx, top, x + dx + sx, top + (l.height)), style.bgColor, WMGraphics.ModeCopy)
- END;
- IF hc THEN style.font.RenderChar(canvas, x + sx, top + (l.ascent) + style.voff, char)
- ELSE WMGraphics.FBRenderChar(canvas, x + sx, top + (l.ascent) + style.voff, char)
- END
- END;
- (* link *)
- IF localTextReader.link # NIL THEN
- canvas.Line(x + sx, top + (l.ascent)+1, x + dx + sx, top + (l.ascent)+1, canvas.color, WMGraphics.ModeSrcOverDst);
- END;
- (* highlight - since highlights store the global text position, the line's starting position needs to be added,
- when operating on the local, bidirectional text reader. *)
- IF bidiTextReader # NIL THEN
- p := GetInternalPos(localTextReader.GetPosition()+sp-1);
- ELSE
- p := localTextReader.GetPosition() - 1;
- END;
- FOR j := 0 TO nofHighlights - 1 DO
- IF (p >= highlights[j].a) & (p < highlights[j].b) THEN
- CASE highlights[j].kind OF
- |HLOver: canvas.Fill(WMGraphics.MakeRectangle(x + sx, top, x + dx + sx, top + (l.height)), highlights[j].color, WMGraphics.ModeSrcOverDst)
- |HLUnder: canvas.Line(x + sx, top + (l.ascent), x + dx + sx, top + (l.ascent), highlights[j].color, WMGraphics.ModeSrcOverDst);
- |HLWave:
- FOR k := 0 TO dx - 1 DO
- t := 1 - ABS((x + k) MOD 4 - 2); (* because of compiler bug on intel *)
- canvas.SetPixel(x + k + sx, top + l.ascent + t, highlights[j].color, WMGraphics.ModeSrcOverDst);
- END;
- ELSE
- END
- END
- END;
- x := x + dx;
- INC(i)
- UNTIL (i >= linelength) OR localTextReader.eot OR (x + sx > w);
- localTextReader.text.ReleaseRead;
- IF showLineNumbersI THEN canvas.RestoreState(canvasState); END;
- END RenderLine;
- PROCEDURE RenderAboveTextMarkers*(canvas : WMGraphics.Canvas);
- VAR x, y, l, pos, i, ascent : LONGINT;
- BEGIN
- AssertLock;
- IF text = NIL THEN RETURN END;
- IF optimize THEN RETURN END;
- text.AcquireRead;
- FOR i := nofPositionMarkers - 1 TO 0 BY -1 DO
- pos := positionMarkers[i].pos.GetPosition();
- l := layout.FindLineNrByPos(pos);
- IF FindScreenPos(pos, x, y) THEN
- IF (l >= 0) & (l < layout.GetNofLines()) THEN
- ascent := layout.lines[l].ascent;
- (* IF ascent = 0 THEN ascent := layout.lines[l].height END;
- IF ascent = 0 THEN ascent := 10 END; *)
- ELSE ascent := 10 END;
- positionMarkers[i].Draw(canvas, x, y, ascent)
- END
- END;
- text.ReleaseRead;
- END RenderAboveTextMarkers;
- PROCEDURE DrawBackground*(canvas : WMGraphics.Canvas);
- VAR la, lb, i, top, t, b : LONGINT; rect, clip : WMRectangles.Rectangle; cstate : WMGraphics.CanvasState;
- BEGIN
- ASSERT(layout # NIL);
- canvas.GetClipRect(clip);
- IF WMRectangles.RectEmpty(clip) THEN RETURN END;
- rect := GetClientRect();
- canvas.SaveState(cstate);
- IF WMRectangles.Intersect(rect, clip) THEN
- DrawBackground^(canvas);
- IF showBorderI THEN
- WMGraphicUtilities.DrawBevel(canvas, rect,
- 1, TRUE, LONGINT(0808080FFH), WMGraphics.ModeCopy)
- END;
- END;
- (* allow clean clipping in at inner border *)
- WMRectangles.ClipRect(rect, borderClip);
- WMRectangles.ClipRect(clip, borderClip);
- canvas.SetClipRect(clip);
- (* draw gutter *)
- rect.r := x0 - 1;
- IF showLineNumbersI & (lineNumberBgColorI # 0) & WMRectangles.Intersect(rect, clip) THEN
- canvas.Fill(rect, lineNumberBgColorI, WMGraphics.ModeSrcOverDst);
- END;
- text.AcquireRead;
- la := FindLineByY(firstLineI, clip.t);
- lb := FindLineByY(firstLineI, clip.b);
- (* prepare selections *)
- FOR i := 0 TO nofHighlights - 1 DO
- highlights[i].a := highlights[i].from.GetPosition();
- highlights[i].b := highlights[i].to.GetPosition();
- IF highlights[i].a > highlights[i].b THEN t := highlights[i].a; highlights[i].a := highlights[i].b; highlights[i].b := t END
- END;
- top := borderClip.t;
- IF (la = lb) & (textAlignV.Get() = WMGraphics.AlignCenter) THEN
- top := (borderClip.t+borderClip.b-layout.lines[la].height) DIV 2;
- (* something is wrong with ascent and height here, does not comply with the notions in fonts *)
- END;
- FOR i := firstLineI TO la - 1 DO
- top := top + (layout.lines[i].height);
- CheckParagraphBegin(i, top);
- CheckParagraphEnd(i, top);
- END;
- IF la >= 0 THEN
- (* draw the lines that intersect the clipping rectangle *)
- FOR i := la TO lb DO
- CheckParagraphBegin(i, top);
- RenderLine(canvas, layout.lines[i], i, top, -1);
- top := top + (layout.lines[i].height);
- CheckParagraphEnd(i, top);
- END
- END;
- RenderAboveTextMarkers(canvas);
- text.ReleaseRead;
- canvas.RestoreState(cstate);
- END DrawBackground;
- PROCEDURE StoreLineEnter;
- VAR pos, cl : LONGINT;
- BEGIN
- pos := cursor.GetPosition();
- cl := layout.FindLineNrByPos(pos);
- lineEnter := pos - layout.GetLineStartPos(cl)
- END StoreLineEnter;
- (* navigation *)
- PROCEDURE WheelMove*(dz: LONGINT); (** PROTECTED *)
- VAR ddz: DZ;
- BEGIN
- IF modifierFlags * Inputs.Ctrl # {} THEN (* CTRL pressed -> Resize Font*)
- text.AcquireWrite;
- NEW(ddz, dz);
- text.UpdateAttributes(0, text.GetLength(), ChangeAttribute, ddz);
- text.ReleaseWrite;
- ELSIF mouseWheelScrollSpeedI # 0 THEN
- firstLine.Set(firstLine.Get() + mouseWheelScrollSpeedI * dz)
- END;
- END WheelMove;
- (* abort a possible start of a command. Clear the command start indicator, if it was set *)
- PROCEDURE AbortStart;
- BEGIN
- ASSERT(IsCallFromSequencer());
- IF commandMarker # NIL THEN
- RemoveHighlight(commandMarker);
- commandMarker := NIL
- END;
- canStart := FALSE
- END AbortStart;
- (*
- Handle double-click at text position <pos>.
- Select the double-clicked word, whitespace or line.
- Some explanations:
- Why utilreader.GetPosition()+2 when searching to the left?
- After we read the last character that should be included, the position of the reader is decremented.
- When we now read the next character and see that it should not be included, the reader is decremented again.
- -> The last character to be included was found at position utilreader.GetPosition()+2 (except when we reach EOT)
- The same applies when search to the right. But to highlight the character at, for example, position 4, we need a highlight from 4-5.
- That's why utilreader.GetPosition()-1 is used instead of utilreader.GetPosition()-2.
- *)
- PROCEDURE DoubleClickSelect(pos : LONGINT);
- CONST
- LineFeed = 0AH;
- Underscore = 05FH;
- VAR
- char : Texts.Char32;
- from, to : LONGINT;
- BEGIN
- ASSERT(text.HasReadLock());
- utilreader.SetPosition(pos);
- utilreader.SetDirection(1);
- utilreader.ReadCh(char);
- IF (char = LineFeed) OR utilreader.eot THEN (* select line *)
- IF utilreader.eot THEN to := pos;
- ELSE to := pos+1;
- END;
- from := TextUtilities.FindPosLineStart(utilreader, pos);
- ELSIF TextUtilities.IsWhiteSpace(char,text.isUTF) THEN
- WHILE ~utilreader.eot & TextUtilities.IsWhiteSpace(char,text.isUTF) & (char # LineFeed) DO utilreader.ReadCh(char); END;
- IF utilreader.eot THEN to := utilreader.text.GetLength();
- ELSE to := utilreader.GetPosition()-1;
- END;
- utilreader.SetPosition(pos);
- utilreader.SetDirection(-1);
- utilreader.ReadCh(char);
- WHILE ~utilreader.eot & TextUtilities.IsWhiteSpace(char,text.isUTF) & (char # LineFeed) DO utilreader.ReadCh(char); END;
- IF utilreader.eot THEN from := 0;
- ELSE from := utilreader.GetPosition()+2;
- END;
- ELSIF TextUtilities.IsAlphaNum(char) OR (char = Underscore) THEN (* select word *)
- WHILE ~utilreader.eot & (TextUtilities.IsAlphaNum(char) OR (char = Underscore)) DO utilreader.ReadCh(char); END;
- IF utilreader.eot THEN to := utilreader.text.GetLength();
- ELSE to := utilreader.GetPosition()-1;
- END;
- utilreader.SetPosition(pos);
- utilreader.SetDirection(-1);
- utilreader.ReadCh(char);
- WHILE ~utilreader.eot & (TextUtilities.IsAlphaNum(char) OR (char = Underscore)) DO utilreader.ReadCh(char); END;
- IF utilreader.eot THEN from := 0;
- ELSE from := utilreader.GetPosition()+2;
- END;
- ELSE (* select the character at text position pos *)
- from := pos; to := pos+1;
- END;
- selection.SetFromTo(from, to);
- cursor.SetVisible(to - from > 0);
- END DoubleClickSelect;
- PROCEDURE SetInterclick(new : LONGINT);
- VAR old : LONGINT;
- BEGIN
- old := interclick;
- IF (old # new) THEN
- interclick := new;
- CASE new OF
- | Interclick01: selection.SetColor(SelectionColorInterclick01);
- | Interclick02: selection.SetColor(SelectionColorInterclick02);
- ELSE
- selection.SetColor(SelectionColor);
- END;
- END;
- END SetInterclick;
- PROCEDURE PointerDown*(x, y : LONGINT; keys : SET);
- VAR pos, a, b, internalPos : LONGINT; oldInterclick : LONGINT;
- BEGIN
- ViewToTextPos(x,y,pos);
- internalPos := GetInternalPos(pos);
- oldInterclick := interclick;
- IF (keys * {0, 1} = {0,1}) THEN SetInterclick(Interclick01);
- ELSIF (keys * {0,2} = {0,2}) THEN SetInterclick(Interclick02);
- ELSE SetInterclick(InterclickNone);
- END;
- (* Determine whether to cancel an interclick if any *)
- IF (oldInterclick = InterclickCancelled) OR
- ((oldInterclick # InterclickNone) & (interclick # InterclickNone)) THEN
- SetInterclick(InterclickCancelled);
- END;
- IF allowCommandExecution.Get() & (keys * {0, 1, 2} = {1}) THEN
- canStart := TRUE; openFile := FALSE;
- IF commandMarker = NIL THEN
- commandMarker := CreateHighlight();
- commandMarker.SetKind(HLUnder);
- commandMarker.SetColor(LONGINT(0FF0000FFH));
- text.AcquireRead;
- FindCommand(internalPos, a, b);
- commandMarker.SetFromTo(a, b);
- cursor.SetPosition(pos);
- text.ReleaseRead
- END;
- END;
- IF canStart & (2 IN keys) THEN openFile := TRUE; SetInterclick(InterclickCancelled); END;
- IF keys * {0, 1, 2} = {0, 1, 2} THEN AbortStart END;
- IF allowPiemenu.Get() & (keys * {0, 1, 2} = {2}) THEN
- text.AcquireRead;
- ViewToTextPos(x, y, pos);
- cursor.SetPosition(pos);
- text.ReleaseRead;
- ShowContextMenu(x, y)
- END;
- IF allowTextSelection.Get() &
- ( (keys * {0, 1, 2} = {0}) (* left mouse for select *)
- OR (keys * {0, 1, 2} = {1}) & doubleclickedWord (* remove selection when double clicking *)
- OR (keys * {0,1,2} = {2}) & (~allowPiemenu.Get())) (* right mouse for selection if pie menu is not enabled *)
- THEN
- AbortStart;
- text.AcquireRead;
- ViewToTextPos(x, y, pos);
- dragPossible := FALSE; selectWords := FALSE;
- IF internalPos >= 0 THEN
- selection.Sort;
- IF (internalPos >= selection.a) & (internalPos < selection.b) & (interclick = InterclickNone) THEN
- dragPossible := TRUE; downX := x; downY := y
- ELSIF (interclick = InterclickNone) THEN
- (* clicking the same position twice --> Word Selection Mode *)
- IF (internalPos = GetInternalPos(cursor.GetPosition())) OR ((internalPos - 1 = GetInternalPos(cursor.GetPosition())) & (internalPos - 1 = text.GetLength())) THEN
- (* Workaround: The 2nd check is for the very last line of a text. LayoutLine gives pos = text.GetLength()+1 *)
- selectWords := TRUE; wordSelOrdered := TRUE;
- doubleclickedWord := TRUE;
- DoubleClickSelect(internalPos);
- ELSE
- selection.SetFromTo(internalPos, internalPos); (* reset selection *)
- cursor.SetVisible(TRUE);
- END;
- selecting := TRUE;
- END
- END;
- cursor.SetPosition(pos);
- text.ReleaseRead;
- CursorChanged
- END;
- END PointerDown;
- PROCEDURE PointerMove*(x, y : LONGINT; keys : SET);
- VAR pos, a, b, internalPos : LONGINT;
- BEGIN
- IF ~canStart & dragPossible THEN
- IF (ABS(x - downX) > DragDist) OR (ABS(y - downY) > DragDist) THEN dragPossible := FALSE; AutoStartDrag END
- ELSE
- IF (selecting OR canStart) & (interclick = InterclickNone) THEN
- text.AcquireRead;
- ViewToTextPos(x, y, pos);
- internalPos := GetInternalPos(pos);
- IF selecting & ~doubleclickedWord THEN
- selection.Sort;
- IF selectWords THEN
- IF internalPos < selection.from.GetPosition() THEN
- pos := TextUtilities.FindPosWordLeft(utilreader, internalPos - 1);
- ELSE
- pos := TextUtilities.FindPosWordRight(utilreader, internalPos + 1);
- END;
- selection.SetTo(internalPos)
- ELSE
- selection.SetTo(internalPos);
- END;
- selection.Sort;
- cursor.SetVisible(selection.b - selection.a <= 0);
- Texts.SetLastSelection(text, selection.from, selection.to);
- cursor.SetPosition(pos);
- StoreLineEnter;
- ELSIF canStart THEN
- IF commandMarker # NIL THEN
- FindCommand(internalPos, a, b);
- commandMarker.SetFromTo(a, b)
- END
- END;
- IF doubleclickedWord THEN doubleclickedWord := FALSE; END; (* allow selecting again *)
- text.ReleaseRead;
- CursorChanged
- END
- END
- END PointerMove;
- PROCEDURE PointerUp*(x, y : LONGINT; keys : SET);
- BEGIN
- IF canStart & (commandMarker # NIL) THEN
- commandMarker.Sort;
- StartCommand((commandMarker.a + commandMarker.b) DIV 2, openFile);
- AbortStart
- END;
- IF modifierFlags * Inputs.Ctrl # {} THEN
- onCtrlClicked.Call(NIL)
- END;
- selecting := FALSE;
- doubleclickedWord := FALSE;
- IF (keys * {0,1,2} = {}) THEN
- IF (interclick = Interclick02) THEN
- DeleteSelection;
- END;
- SetInterclick(InterclickNone);
- END;
- IF dragPossible THEN selection.SetFromTo(0, 0); cursor.SetVisible(TRUE); Texts.ClearLastSelection (* reset selection *) END;
- dragPossible := FALSE
- END PointerUp;
- (* Transforms the TextView Coordinates into TextObject obj Coordinates *)
- PROCEDURE TransformCoordinates(VAR x, y : LONGINT; obj : WMComponents.VisualComponent);
- VAR line, pos, x0, y0, y1 : LONGINT;
- BEGIN
- ViewToTextPos(x, y, pos);
- IF FindScreenPos(pos, x0, y0) THEN
- IF x0 > x THEN pos := pos - 1;
- IF FindScreenPos(pos, x0, y0) THEN END;
- END;
- line := layout.FindLineNrByPos(GetInternalPos(pos));
- LineYPos(line, y0, y1);
- x := x - x0;
- y := y - y0;
- IF line >= 0 THEN y := y - (layout.lines[line].ascent - obj.bounds.GetHeight()); END
- END
- END TransformCoordinates;
- (* Change the pointer according to the underlaying component *)
- PROCEDURE ChangePointer(pointerInfo : WMWindowManager.PointerInfo);
- BEGIN
- IF GetPointerInfo() # pointerInfo THEN
- SetPointerInfo(pointerInfo)
- END
- END ChangePointer;
- (* Returns TRUE if an Object is Hit, FALSE otherwise *)
- PROCEDURE HitObject(x, y : LONGINT; (* keys : SET;*) VAR pos : LONGINT; VAR obj : ANY): BOOLEAN;
- VAR ch, tx, ty : LONGINT;
- BEGIN
- text.AcquireRead;
- ViewToTextPos(x, y, pos);
- IF FindScreenPos(pos, tx, ty) THEN
- IF tx > x THEN pos := pos - 1 END
- END;
- utilreader.SetPosition(GetInternalPos(pos));
- utilreader.ReadCh(ch);
- text.ReleaseRead;
- IF ch = Texts.ObjectChar THEN obj := utilreader.object;
- RETURN TRUE
- ELSE
- RETURN FALSE
- END
- END HitObject;
- (* Returns TRUE if a Link is Hit, FALSE otherwise *)
- PROCEDURE HitLink(x, y : LONGINT; VAR pos : LONGINT; VAR link : Texts.Link): BOOLEAN;
- VAR ch, tx, ty : LONGINT;
- BEGIN
- text.AcquireRead;
- ViewToTextPos(x, y, pos);
- IF FindScreenPos(pos, tx, ty) THEN
- IF tx > x THEN pos := pos - 1 END
- END;
- utilreader.SetPosition(GetInternalPos(pos));
- utilreader.ReadCh(ch);
- text.ReleaseRead;
- IF utilreader.link # NIL THEN
- link := utilreader.link;
- RETURN TRUE
- ELSE
- RETURN FALSE
- END
- END HitLink;
- PROCEDURE LinkClick(link : Texts.Link);
- VAR w : LinkWrapper;
- BEGIN
- NEW(w); w.link := link;
- onLinkClicked.Call(w)
- END LinkClick;
- (* builtin behaviour *)
- PROCEDURE LinkClicked*(sender, data : ANY);
- VAR tempLink : ARRAY 2048 OF CHAR;
- tempLabel : ARRAY 256 OF CHAR;
- pos, i : LONGINT;
- BEGIN
- IF data IS LinkWrapper THEN
- COPY(data(LinkWrapper).link^, tempLink);
- IF tempLink[0] = "#" THEN (* internal link *)
- i := 0;
- WHILE tempLink[i] # 0X DO
- tempLabel[i] := tempLink[i+1];
- INC(i);
- END;
- tempLink[i] := 0X;
- (* find label in tv *)
- IF FindLabel(tempLabel, pos) THEN
- i := layout.nofLines-1;
- WHILE (i >= 0) DO
- IF layout.GetLineStartPos(i) < pos THEN firstLine.Set(i); RETURN END;
- DEC(i);
- END;
- END;
- ELSE (* other links *)
- END
- END
- END LinkClicked;
- (* Returns the position of the label in text *)
- PROCEDURE FindLabel*(CONST label : ARRAY OF CHAR; VAR pos : LONGINT): BOOLEAN;
- VAR ch : LONGINT;
- found : BOOLEAN;
- BEGIN
- found := FALSE; pos := 0;
- text.AcquireRead;
- utilreader.SetDirection(1); utilreader.SetPosition(pos);
- REPEAT
- utilreader.ReadCh(ch);
- IF ch = Texts.LabelChar THEN
- IF utilreader.object(Texts.LabelPiece).label^ = label THEN
- found := TRUE;
- END;
- END;
- INC(pos);
- UNTIL utilreader.eot OR found;
- text.ReleaseRead;
- RETURN found;
- END FindLabel;
- (* Drag away operations *)
- PROCEDURE AutoStartDrag*;
- VAR img : WMGraphics.Image;
- c : WMGraphics.BufferCanvas;
- w, h, i, la, lb, top : LONGINT;
- l : LineInfo;
- BEGIN
- text.AcquireRead;
- selection.Sort;
- NEW(dragSelA, text);NEW(dragSelB, text);
- dragSelA.SetPosition(selection.a); dragSelB.SetPosition(selection.b);
- la := Limit(layout.FindLineNrByPos(selection.a), 0, layout.GetNofLines() - 1);
- lb := Limit(layout.FindLineNrByPos(selection.b), 0, layout.GetNofLines() - 1);
- (* estimate the size of the selection *)
- h := 0; w := 0;
- FOR i := la TO lb DO
- h := h + (layout.lines[i].height);
- w := Strings.Max(w, layout.lines[i].width);
- END;
- h := Limit(h, 20, 200);
- w := Limit(w, 20, 400);
- (* render to bitmap *)
- NEW(img); Raster.Create(img, w, h, Raster.BGRA8888);
- NEW(c, img);
- top := 0;
- (* hack the startpos of the first line *)
- l := layout.lines[la]; l.pos := selection.a;
- IF la = lb THEN RenderLine(c, l, la, top, selection.b - selection.a)
- ELSE
- RenderLine(c, l, la, top, -1);
- top := top + l.height
- END;
- FOR i := la + 1 TO lb DO
- IF i = lb THEN
- RenderLine(c, layout.lines[i], i, top, selection.b - layout.lines[i].pos)
- ELSE
- RenderLine(c, layout.lines[i], i, top, -1);
- top := top + (l.height)
- END
- END;
- text.ReleaseRead;
- IF StartDrag(NIL, img, 0,0,DragWasAccepted, NIL) THEN
- ELSE KernelLog.String("WMTextView : Drag could not be started")
- END;
- END AutoStartDrag;
- PROCEDURE DragWasAccepted(sender, data : ANY);
- VAR di : WMWindowManager.DragInfo;
- dt : WMDropTarget.DropTarget;
- itf : WMDropTarget.DropInterface;
- targetText, temp : Texts.Text;
- string : Strings.String;
- pos, a, b, res : LONGINT;
- BEGIN
- IF (dragSelA = NIL) OR (dragSelB = NIL) THEN RETURN END;
- IF (data # NIL) & (data IS WMWindowManager.DragInfo) THEN
- di := data(WMWindowManager.DragInfo);
- IF (di.data # NIL) & (di.data IS WMDropTarget.DropTarget) THEN
- dt := di.data(WMDropTarget.DropTarget)
- ELSE RETURN
- END
- ELSE RETURN
- END;
- itf := dt.GetInterface(WMDropTarget.TypeText);
- IF itf # NIL THEN
- targetText := itf(WMDropTarget.DropText).text;
- IF targetText # NIL THEN
- targetText.AcquireWrite;
- IF ~dragCopy THEN
- IF TraceCopy IN Trace THEN KernelLog.String("WMTextView: Not copy"); KernelLog.Ln; END;
- text.AcquireWrite;
- a := dragSelA.GetPosition(); b := dragSelB.GetPosition();
- pos := itf(WMDropTarget.DropText).pos.GetPosition();
- IF (targetText # text) OR (pos < a) OR (pos > b) THEN
- NEW(temp); temp.AcquireWrite; temp.CopyFromText(text, a, b-a, 0); temp.ReleaseWrite;
- text.Delete(a, b- a);
- pos := itf(WMDropTarget.DropText).pos.GetPosition();
- temp.AcquireRead;
- targetText.CopyFromText(temp, 0, temp.GetLength(), pos);
- temp.ReleaseRead;
- END;
- text.ReleaseWrite
- ELSE
- IF TraceCopy IN Trace THEN KernelLog.String("WMTextView: Copy"); KernelLog.Ln; END;
- text.AcquireRead;
- pos := itf(WMDropTarget.DropText).pos.GetPosition();
- a := dragSelA.GetPosition(); b := dragSelB.GetPosition();
- targetText.CopyFromText(text, a, b-a, pos);
- text.ReleaseRead;
- END;
- targetText.ReleaseWrite
- END;
- RETURN
- END;
- itf := dt.GetInterface(WMDropTarget.TypeString);
- IF (itf # NIL) THEN
- IF ~dragCopy THEN
- text.AcquireWrite;
- a := dragSelA.GetPosition(); b := dragSelB.GetPosition();
- NEW(temp);
- temp.AcquireWrite;
- temp.CopyFromText(text, a, b-a, 0);
- IF (temp.GetLength() > 0) THEN NEW(string, temp.GetLength() * 5); ELSE NEW(string, 1); string[0] := 0X; END;
- temp.ReleaseWrite;
- text.ReleaseWrite;
- TextUtilities.TextToStr(temp, string^);
- itf(WMDropTarget.DropString).Set(string^, res);
- IF res = 0 THEN
- text.AcquireWrite;
- text.Delete(a, b- a);
- text.ReleaseWrite;
- END;
- ELSE
- text.AcquireRead;
- a := dragSelA.GetPosition(); b := dragSelB.GetPosition();
- NEW(temp);
- temp.AcquireWrite;
- temp.CopyFromText(text, a, b-a, 0);
- IF (temp.GetLength() > 0) THEN NEW(string, temp.GetLength() * 5); ELSE NEW(string, 1); string[0] := 0X; END;
- temp.ReleaseWrite;
- text.ReleaseRead;
- TextUtilities.TextToStr(temp, string^);
- itf(WMDropTarget.DropString).Set(string^, res);
- END;
- END;
- END DragWasAccepted;
- (* Drag onto operations *)
- PROCEDURE DragOver(x, y : LONGINT; dragInfo : WMWindowManager.DragInfo);
- VAR pos : LONGINT;
- BEGIN
- IF takesFocus.Get() THEN
- text.AcquireRead;
- ViewToTextPos(x, y, pos);
- cursor.SetVisible(TRUE);
- cursor.SetPosition(pos);
- StoreLineEnter;
- text.ReleaseRead
- END;
- END DragOver;
-
- PROCEDURE ConfirmDrag(accept: BOOLEAN; dragInfo: WMWindowManager.DragInfo);
- BEGIN
- IF dragInfo.onAccept # NIL THEN
- dragInfo.onAccept(SELF, dragInfo)
- END;
- END ConfirmDrag;
-
- PROCEDURE DragDropped*(x, y : LONGINT; dragInfo : WMWindowManager.DragInfo);
- VAR dropTarget : TextDropTarget;
- pos, internalPos : LONGINT;
- p : Texts.TextPosition;
- BEGIN
- IF takesFocus.Get() THEN
- text.AcquireRead;
- ViewToTextPos(x, y, pos) ;
- (* prevent a selection from being dropped behind the paragraph separator *)
- internalPos := GetInternalPos(pos);
- IF text.isUTF & (layout.bidiFormatter # NIL) THEN
- IF layout.bidiFormatter.IsLastCharacterInLine(internalPos) THEN
- DEC(internalPos);
- END;
- END;
- NEW(p, text); p.SetPosition(internalPos);
- NEW(dropTarget, text, p);
- text.ReleaseRead;
- IF ~hasFocus & ~alwaysShowCursorI THEN cursor.SetVisible(FALSE) END;
- dragInfo.data := dropTarget;
- ConfirmDrag(TRUE, dragInfo);
- ELSE
- ConfirmDrag(FALSE, dragInfo);
- END;
- END DragDropped;
- PROCEDURE CopySelection*;
- BEGIN
- IF isPassword.Get() THEN RETURN END;
- text.AcquireRead;
- Texts.clipboard.AcquireWrite;
- selection.Sort;
- IF selection.b - selection.a > 0 THEN
- (* clear the clipboard *)
- IF Texts.clipboard.GetLength() > 0 THEN Texts.clipboard.Delete(0, Texts.clipboard.GetLength()) END;
- Texts.clipboard.CopyFromText(text, selection.a, selection.b - selection.a, 0);
- END;
- Texts.clipboard.ReleaseWrite;
- text.ReleaseRead
- END CopySelection;
- PROCEDURE DeleteSelection*;
- BEGIN
- Acquire; (* protect cursor *)
- text.AcquireWrite;
- selection.Sort;
- text.Delete(selection.a, selection.b - selection.a);
- cursor.SetVisible(TRUE);
- text.ReleaseWrite;
- Release;
- END DeleteSelection;
- PROCEDURE Paste*;
- BEGIN
- text.AcquireWrite;
- Texts.clipboard.AcquireRead;
- IF Texts.clipboard.GetLength() > 0 THEN
- IF selection.b - selection.a # 0 THEN DeleteSelection() END;
- text.CopyFromText(Texts.clipboard, 0, Texts.clipboard.GetLength(), cursor.GetPosition())
- END;
- Texts.clipboard.ReleaseRead;
- text.ReleaseWrite
- END Paste;
- PROCEDURE SelectAll*;
- BEGIN
- Acquire; (* protect cursor *)
- text.AcquireRead;
- selection.SetFromTo(0, text.GetLength());
- cursor.SetVisible(text.GetLength() <= 0);
- Texts.SetLastSelection(text, selection.from, selection.to);
- text.ReleaseRead;
- Release;
- END SelectAll;
- (* Prepare to start the selection by keyboard. Clear the selection, if it is not contigous *)
- PROCEDURE KeyStartSelection(pos : LONGINT);
- BEGIN
- IF selection.to.GetPosition() # pos THEN selection.SetFromTo(pos, pos); cursor.SetVisible(TRUE); Texts.ClearLastSelection END;
- END KeyStartSelection;
- (* update the keyboard selection with the new position, redraw from the last StartSelection *)
- PROCEDURE KeyUpdateSelection(pos : LONGINT);
- BEGIN
- selection.SetTo(pos);
- selection.Sort;
- cursor.SetVisible(selection.b - selection.a <= 0);
- Texts.SetLastSelection(text, selection.from, selection.to)
- END KeyUpdateSelection;
- PROCEDURE CursorChanged;
- BEGIN
- cursorBlinker.Show(cursor);
- IF (onCursorChanged # NIL) THEN onCursorChanged END
- END CursorChanged;
- PROCEDURE CursorUp*(select : BOOLEAN);
- VAR
- pos, cPos, cl, lineStart : LONGINT;
- BEGIN
- Acquire;
- text.AcquireRead;
- pos := GetInternalPos(cursor.GetPosition());
- IF select THEN
- KeyStartSelection(pos)
- ELSE
- selection.SetFromTo(pos, pos);
- cursor.SetVisible(TRUE);
- Texts.ClearLastSelection
- END;
- cl := layout.FindLineNrByPos(pos);
- IF cl > 0 THEN
- DEC(cl);
- lineStart := layout.GetLineStartPos(cl);
- cPos := lineStart + Strings.Min(layout.GetLineLength(cl) - 1, lineEnter);
- cursor.SetPosition(cPos);
- IF cl < firstLineI THEN firstLine.Set(cl) END
- END;
- IF select THEN
- KeyUpdateSelection(GetInternalPos(cursor.GetPosition()));
- END;
- text.ReleaseRead;
- Release;
- CursorChanged
- END CursorUp;
- PROCEDURE CursorDown*(select : BOOLEAN);
- VAR pos, cPos, cl, lineStart : LONGINT;
- BEGIN
- Acquire;
- text.AcquireRead;
- pos := GetInternalPos(cursor.GetPosition());
- IF select THEN
- KeyStartSelection(pos)
- ELSE
- selection.SetFromTo(pos, pos);
- cursor.SetVisible(TRUE);
- Texts.ClearLastSelection
- END;
- cl := layout.FindLineNrByPos(pos);
- IF cl < layout.GetNofLines() - 1 THEN
- INC(cl);
- lineStart := layout.GetLineStartPos(cl);
- cPos := lineStart + Strings.Min(layout.GetLineLength(cl) - 1, lineEnter);
- cursor.SetPosition(cPos);
- IF cl > FindLineByY(firstLineI, bounds.GetHeight() - bordersI.b) THEN firstLine.Set(firstLineI + 1 ) END
- END;
- IF select THEN
- KeyUpdateSelection(GetInternalPos(cursor.GetPosition()))
- END;
- text.ReleaseRead;
- Release;
- CursorChanged
- END CursorDown;
- (* Move the cursor one character/word to the left *)
- PROCEDURE CursorLeft*(word, select : BOOLEAN);
- VAR
- pos, cPos, wPos : LONGINT;
- BEGIN
- Acquire;
- text.AcquireRead;
- PositionDebugging.SetPos(GetInternalPos(cursor.GetPosition()),cursor.GetPosition());
- pos := GetInternalPos(cursor.GetPosition());
- IF select THEN
- KeyStartSelection(pos)
- ELSE
- selection.SetFromTo(pos, pos);
- cursor.SetVisible(TRUE);
- Texts.ClearLastSelection
- END;
- cPos := GetInternalPos(cursor.GetPosition()) - 1;
- IF ~word THEN
- cursor.SetPosition(GetDisplayPos(cPos));
- ELSE
- wPos := TextUtilities.FindPosWordLeft(utilreader, cPos);
- cursor.SetPosition(GetDisplayPos(wPos));
- END;
- IF select THEN
- KeyUpdateSelection(GetInternalPos(cursor.GetPosition()))
- END;
- StoreLineEnter;
- text.ReleaseRead;
- Release;
- CursorChanged
- END CursorLeft;
- (* Move the cursor one character/word to the right *)
- PROCEDURE CursorRight*(word, select : BOOLEAN);
- VAR
- pos, cPos, wPos : LONGINT;
- BEGIN
- Acquire;
- text.AcquireRead;
- PositionDebugging.SetPos(GetInternalPos(cursor.GetPosition()),cursor.GetPosition());
- pos := GetInternalPos(cursor.GetPosition());
- IF select THEN
- KeyStartSelection(pos)
- ELSE
- selection.SetFromTo(pos, pos);
- cursor.SetVisible(TRUE);
- Texts.ClearLastSelection
- END;
- cPos := GetInternalPos(cursor.GetPosition()) + 1;
- IF ~word THEN
- cursor.SetPosition(GetDisplayPos(cPos));
- ELSE
- wPos := TextUtilities.FindPosWordRight(utilreader, cPos);
- cursor.SetPosition(GetDisplayPos(wPos));
- END;
- IF select THEN
- KeyUpdateSelection(GetInternalPos(cursor.GetPosition()))
- END;
- StoreLineEnter;
- text.ReleaseRead;
- Release;
- CursorChanged
- END CursorRight;
- PROCEDURE PageDown*(select : BOOLEAN);
- VAR dy : LONGINT; i, pos, iPos : LONGINT;
- cx, cy : LONGINT;
- BEGIN
- Acquire;
- text.AcquireRead;
- iPos := GetInternalPos(cursor.GetPosition());
- IF select THEN
- KeyStartSelection(iPos)
- ELSE
- selection.SetFromTo(iPos, iPos);
- cursor.SetVisible(TRUE);
- Texts.ClearLastSelection
- END;
- IF firstLineI = layout.GetNofLines() - 1 THEN
- cursor.SetPosition(text.GetLength());
- ELSE
- (* save cursor screen pos for repositioning *)
- IF ~FindScreenPos(cursor.GetPosition(), cx, cy) THEN cx := 0; cy := 0 END;
- i := firstLineI; dy := 0;
- WHILE (i < layout.GetNofLines() - 1) & (dy < bounds.GetHeight() - bordersI.t - bordersI.b) DO
- INC(i); dy := dy + (layout.lines[i].height)
- END;
- firstLine.Set(i);
- (* set cursor to nearest pos on new page *)
- ViewToTextPos(cx, cy, pos);
- IF pos >= 0 THEN
- cursor.SetPosition(pos);
- END;
- END;
- IF select THEN
- KeyUpdateSelection(GetInternalPos(cursor.GetPosition()))
- END;
- text.ReleaseRead;
- Release;
- CursorChanged
- END PageDown;
- PROCEDURE PageUp*(select : BOOLEAN);
- VAR dy : LONGINT; i, pos, iPos : LONGINT;
- cx, cy : LONGINT;
- BEGIN
- Acquire;
- text.AcquireRead;
- iPos := GetInternalPos(cursor.GetPosition());
- IF select THEN
- KeyStartSelection(iPos)
- ELSE
- selection.SetFromTo(iPos, iPos);
- cursor.SetVisible(TRUE);
- Texts.ClearLastSelection
- END;
- IF firstLineI = 0 THEN
- cursor.SetPosition(0);
- ELSE
- (* save cursor screen pos for repositioning *)
- IF ~FindScreenPos(cursor.GetPosition(), cx, cy) THEN cx := 0; cy := 0 END;
- (* go up one page but at least one page *)
- i := firstLineI; dy := 0;
- WHILE (i > 0) & (dy < bounds.GetHeight() - bordersI.t - bordersI.b) DO
- DEC(i); dy := dy + (layout.lines[i].height)
- END;
- IF (i > 0) & (i = firstLineI) THEN DEC(i) END;
- firstLine.Set(i);
- (* set cursor to nearest pos on new page *)
- ViewToTextPos(cx, cy, pos);
- IF pos >= 0 THEN
- cursor.SetPosition(pos);
- END
- END;
- IF select THEN
- KeyUpdateSelection(GetInternalPos(cursor.GetPosition()))
- END;
- text.ReleaseRead;
- Release;
- CursorChanged
- END PageUp;
- PROCEDURE Home*(ctrl, select : BOOLEAN);
- VAR
- lineStart, cl, pos : LONGINT;
- BEGIN
- Acquire;
- text.AcquireRead;
- pos := GetInternalPos(cursor.GetPosition());
- IF select THEN
- KeyStartSelection(pos)
- ELSE
- selection.SetFromTo(pos, pos);
- cursor.SetVisible(TRUE);
- Texts.ClearLastSelection
- END;
- IF ctrl THEN
- cursor.SetPosition(GetDisplayPos(0));
- firstLine.Set(0)
- ELSE
- cl := layout.FindLineNrByPos(cursor.GetPosition());
- lineStart := layout.GetLineStartPos(cl);
- cursor.SetPosition(GetDisplayPos(lineStart));
- END;
- StoreLineEnter;
- IF select THEN
- KeyUpdateSelection(GetInternalPos(cursor.GetPosition()))
- END;
- text.ReleaseRead;
- Release;
- CursorChanged
- END Home;
- PROCEDURE End*(ctrl, select : BOOLEAN);
- VAR lineEnd, textLength, cl, pos, dispPos: LONGINT;
- BEGIN
- Acquire;
- text.AcquireRead;
- pos := GetInternalPos(cursor.GetPosition());
- IF select THEN
- KeyStartSelection(pos)
- ELSE
- selection.SetFromTo(pos, pos);
- cursor.SetVisible(TRUE);
- Texts.ClearLastSelection
- END;
- IF ctrl THEN
- textLength := text.GetLength();
- cursor.SetPosition(GetDisplayPos(textLength));
- firstLine.Set(layout.FindLineNrByPos(text.GetLength()))
- ELSE
- cl := layout.FindLineNrByPos(cursor.GetPosition());
- lineEnd := layout.GetLineStartPos(cl) + layout.GetLineLength(cl) - 1;
- dispPos := GetDisplayPos(lineEnd);
- cursor.SetPosition(dispPos);
- END;
- StoreLineEnter;
- IF select THEN
- KeyUpdateSelection(GetInternalPos(cursor.GetPosition()))
- END;
- text.ReleaseRead;
- Release;
- CursorChanged
- END End;
- PROCEDURE KeyEvent*(ucs :LONGINT; flags : SET; VAR keysym : LONGINT);
- BEGIN
- modifierFlags := flags;
- IF Inputs.Release IN flags THEN RETURN END;
- dragCopy := modifierFlags * Inputs.Ctrl # {};
- IF keysym = 01H THEN (* Ctrl-A *)
- SelectAll
- ELSIF keysym = 03H THEN (* Ctrl-C *)
- CopySelection
- ELSIF (keysym = 0FF63H) & (flags * Inputs.Ctrl # {}) THEN (*Ctrl Insert *)
- CopySelection
- ELSIF keysym = 12H THEN (* Ctrl-R *)
- layout.FullLayout(TRUE); Invalidate;CheckNumberOfLines;
- KernelLog.String("Refreshed"); KernelLog.Ln;
- ELSIF keysym = 0FF51H THEN (* Cursor Left *)
- CursorLeft(flags * Inputs.Ctrl # {}, flags * Inputs.Shift # {})
- ELSIF keysym = 0FF53H THEN (* Cursor Right *)
- CursorRight(flags * Inputs.Ctrl # {}, flags * Inputs.Shift # {})
- ELSIF keysym = 0FF54H THEN (* Cursor Down *)
- CursorDown(flags * Inputs.Shift # {})
- ELSIF keysym = 0FF52H THEN (* Cursor Up *)
- CursorUp(flags * Inputs.Shift # {})
- ELSIF keysym = 0FF56H THEN (* Page Down *)
- PageDown(flags * Inputs.Shift # {})
- ELSIF keysym = 0FF55H THEN (* Page Up *)
- PageUp(flags * Inputs.Shift # {})
- ELSIF keysym = 0FF50H THEN (* Cursor Home *)
- Home(flags * Inputs.Ctrl # {}, flags * Inputs.Shift # {})
- ELSIF keysym = 0FF57H THEN (* Cursor End *)
- End(flags * Inputs.Ctrl # {}, flags * Inputs.Shift # {})
- END
- END KeyEvent;
- (* called by users that override the KeyEvents to allow copy drag drop *)
- PROCEDURE SetFlags*(flags : SET);
- BEGIN
- modifierFlags := flags;
- dragCopy := modifierFlags * Inputs.Ctrl # {};
- END SetFlags;
- PROCEDURE FindCommandRange*(pos: LONGINT; VAR start, end, nofLastSelections : LONGINT);
- VAR ch : LONGINT; string : ARRAY 23 OF CHAR; i : LONGINT; sDoCommands, lastWasTilde : BOOLEAN;
- escapeString: ARRAY 32 OF LONGINT; escapePos: LONGINT; escape: BOOLEAN;
- (* note: this simple algorithm can be emplyed if the substring to be implicitly searched for does not contain its first character *)
- PROCEDURE String(escape: BOOLEAN; CONST escapeString: ARRAY OF LONGINT);
- VAR done: BOOLEAN; escapePos: LONGINT;
- BEGIN
- done := FALSE; escapePos := -1;
- REPEAT
- utilreader.ReadCh(ch);
- IF ch = ORD('"') THEN
- IF escape THEN
- escapePos := 0;
- ELSE
- done := TRUE
- END;
- ELSIF escapePos >= 0 THEN
- IF escapeString[escapePos] = 0 THEN
- IF ch =ORD("\") THEN done := TRUE
- ELSE escapePos := -1
- END;
- ELSIF escapeString[escapePos] # ch THEN
- escapePos := -1;
- ELSE
- INC(escapePos);
- END;
- END;
- UNTIL done OR utilreader.eot;
- END String;
- BEGIN
- nofLastSelections := 0;
- text.AcquireRead;
- utilreader.SetDirection(-1); utilreader.SetPosition(pos);
- REPEAT utilreader.ReadCh(ch) UNTIL TextUtilities.IsWhiteSpace(ch,text.isUTF) OR utilreader.eot;
- start := utilreader.GetPosition() + 2;
- IF utilreader.eot THEN DEC(start, 2) END;
- (* search ~ *)
- i := 0; sDoCommands := FALSE; lastWasTilde := FALSE;
- utilreader.SetDirection(1); utilreader.SetPosition(start);
- REPEAT
- utilreader.ReadCh(ch);
- IF ch = ORD('"') THEN
- escapeString[escapePos] := 0;
- String(escape, escapeString);
- ELSIF ch =ORD("\") THEN
- escape := TRUE;
- escapePos := 0;
- ELSIF escape THEN
- IF TextUtilities.IsWhiteSpace(ch,text.isUTF) THEN escape := FALSE
- ELSE escapeString[escapePos] := ch; INC(escapePos);
- END;
- END;
- (* check whether the command is SystemTools.DoCommands *)
- IF (i < 22) THEN
- string[i] := CHR(ch);
- INC(i);
- IF (i = 22) THEN
- string[22] := 0X;
- IF (string = "SystemTools.DoCommands") OR Strings.StartsWith2("PreliminaryCommands",string) THEN
- sDoCommands := TRUE;
- END;
- END;
- END;
- IF (CHR(ch) = "^") THEN
- INC(nofLastSelections);
- END;
- (* We do a special treatment of the command SystemTools.DoCommands since we don't want a single
- tilde character to delimit the parameter string for the particular command - but two tilde characters *)
- IF sDoCommands THEN
- IF (ch = ORD("~")) THEN
- IF ~lastWasTilde THEN
- lastWasTilde := TRUE;
- utilreader.ReadCh(ch);
- ELSE
- (* Two tilde characters only separated with whitespace means this is the
- end of the SystemTools.DoCommands parameter string *)
- END;
- ELSIF lastWasTilde & ~TextUtilities.IsWhiteSpace(ch,text.isUTF) THEN
- lastWasTilde := FALSE;
- END;
- END;
- UNTIL (ch = ORD("~")) OR (utilreader.eot);
- end := utilreader.GetPosition() - 1;
- IF utilreader.eot THEN INC(end) END;
- text.ReleaseRead
- END FindCommandRange;
- PROCEDURE FindCommand*(pos: LONGINT; VAR start, end : LONGINT);
- VAR ch : LONGINT;
- BEGIN
- text.AcquireRead;
- utilreader.SetDirection(-1); utilreader.SetPosition(pos);
- REPEAT utilreader.ReadCh(ch) UNTIL TextUtilities.IsWhiteSpace(ch,text.isUTF) OR utilreader.eot;
- start := utilreader.GetPosition() + 2;
- IF utilreader.eot THEN DEC(start, 2) END;
- utilreader.SetDirection(1); utilreader.SetPosition(pos);
- REPEAT utilreader.ReadCh(ch) UNTIL TextUtilities.IsWhiteSpace(ch,text.isUTF) OR utilreader.eot;
- end := utilreader.GetPosition() - 1;
- IF utilreader.eot THEN INC(end) END;
- text.ReleaseRead;
- END FindCommand;
- (** Start the command in the text, starting on pos (or wordboundary before),
- caller should hold lock on text to make the pos stable *)
- PROCEDURE StartCommand*(pos : LONGINT; openFile : BOOLEAN);
- VAR
- start, end, bufSize : LONGINT;
- context : Commands.Context;
- arg : Streams.StringReader;
- command : ARRAY MaxCommandLength OF CHAR;
- parameters : POINTER TO ARRAY OF CHAR;
- s : Strings.String;
- msg : ARRAY 128 OF CHAR;
- ignore : Modules.Name;
- paramSize, nofLastSelections, i, j, a, b, res : LONGINT;
- selectionText : Texts.Text;
- selectionOk : BOOLEAN;
- from, to: Texts.TextPosition;
- commandCaller:OBJECT;
- commandWriter, errorWriter: Streams.Writer;
- BEGIN
- Acquire;
- text.AcquireRead;
- IF openFile THEN FindCommand(pos, start, end)
- ELSE FindCommandRange(pos, start, end, nofLastSelections)
- END;
- bufSize := Strings.Max(Strings.Min((end - start) * 5 + 1 (* for UTF *), MaxCallParameterBuf), 1);
- NEW(s, bufSize);
- paramSize := 0;
- TextUtilities.SubTextToStrAt(text, start, end - start, paramSize, s^);
- INC(paramSize);
- text.ReleaseRead;
- Release;
- IF Inputs.Shift * modifierFlags # {} THEN
- (*
- Command / open will not see the caller => called as if no calling context was specified.
- => Opening a text while holding a shift key down will usually result in a new viewer being opened.
- *)
- commandCaller := NIL
- ELSE
- commandCaller := SELF.commandCaller;
- END;
- IF openFile THEN
- FileHandlers.OpenFile(s^, NIL, commandCaller)
- ELSE
- command := "";
- i := 0;
- WHILE (i < MaxCommandLength) & (s[i] # 0X) & (s[i] # ";") & (s[i] # " ") & (s[i] # 09X) & (s[i] # 0DX) & (s[i] # 0AX) DO
- command[i] := s[i]; INC(i);
- END;
- IF i < MaxCommandLength THEN
- command[i] := 0X;
- INC(i);
- Commands.Split(command, ignore, ignore, res, msg);
- IF res # Commands.Ok THEN
- KernelLog.String("WMTextView: Command parsing error, res: "); KernelLog.Int(res, 0);
- KernelLog.String(" ("); KernelLog.String(msg); KernelLog.String(")"); KernelLog.Ln;
- RETURN;
- END;
- ELSE
- KernelLog.String("WMTextView: Command execution error: Command too long"); KernelLog.Ln;
- RETURN;
- END;
- IF (Inputs.Alt * modifierFlags # {}) THEN
- (* execute AltMMCommand with actual command and its parameters as parameter *)
- COPY(AltMMCommand, command);
- commandWriter := NIL; errorWriter := NIL;
- i := 0;
- ELSE
- commandWriter := SELF.commandWriter;
- errorWriter := SELF.errorWriter;
- END;
- IF (i < LEN(s)) THEN (* copy parameter string *)
- selectionOk := FALSE;
- IF (nofLastSelections > 0) THEN
- IF Texts.GetLastSelection(selectionText, from, to) THEN
- selectionOk := TRUE;
- selectionText.AcquireRead;
- a := Strings.Min(from.GetPosition(), to.GetPosition());
- b := Strings.Max(from.GetPosition(), to.GetPosition());
- INC(paramSize, b - a + 1);
- END;
- END;
- NEW(parameters, paramSize);
- j := 0;
- WHILE (i < LEN(s)) & (j < LEN(parameters)-1) DO
- IF (s[i] = "^") & selectionOk THEN
- TextUtilities.SubTextToStrAt(selectionText, a, b - a, j, parameters^);
- ELSE
- parameters[j] := s[i]; INC(j);
- END;
- INC(i);
- END;
- parameters[j] := 0X;
- IF selectionOk THEN
- selectionText.ReleaseRead;
- END;
- ELSE
- NEW(parameters, 1); parameters[0] := 0X;
- END;
- NEW(arg, LEN(parameters)); arg.SetRaw(parameters^, 0, LEN(parameters));
- NEW(context, NIL, arg, commandWriter, errorWriter, commandCaller);
- IF TraceCommands IN Trace THEN
- KernelLog.String("WMTextView: Executing command: '"); KernelLog.String(command); KernelLog.String("'");
- KernelLog.String(", parameters: ");
- IF (parameters[0] = 0X) THEN KernelLog.String("None"); ELSE KernelLog.String("'"); KernelLog.String(parameters^); KernelLog.String("'"); END;
- KernelLog.Ln;
- END;
- Commands.Activate(command, context, {}, res, msg);
- IF (res # Commands.Ok) THEN
- IF commandWriter # NIL THEN
- commandWriter.String("WMTextView: Command execution error, res: "); commandWriter.Int(res, 0);
- commandWriter.String(" ("); commandWriter.String(msg); commandWriter.String(")"); commandWriter.Ln;
- commandWriter.Update;
- ELSE
- KernelLog.String("WMTextView: Command execution error, res: "); KernelLog.Int(res, 0);
- KernelLog.String(" ("); KernelLog.String(msg); KernelLog.String(")"); KernelLog.Ln;
- END;
- END;
- END;
- END StartCommand;
- PROCEDURE Start(sender, data: ANY);
- VAR msg: ARRAY 512 OF CHAR; res: LONGINT;
- BEGIN
- IF (data # NIL) & (data IS ClickInfo) THEN
- IF data(ClickInfo).cmdPar # NIL THEN
- Commands.Call(data(ClickInfo).cmdPar^, {}, res, msg);
- IF res # 0 THEN KernelLog.String("WMTextView: "); KernelLog.String(msg); KernelLog.Ln END;
- END
- END
- END Start;
- PROCEDURE Open(sender, data: ANY);
- BEGIN
- IF (data # NIL) & (data IS ClickInfo) THEN
- IF data(ClickInfo).cmd # NIL THEN
- FileHandlers.OpenFile(data(ClickInfo).cmd^, NIL, commandCaller)
- END
- END
- END Open;
- PROCEDURE PieMenuStart(sender, data: ANY);
- BEGIN
- Start(piemenu, piemenu.userData)
- END PieMenuStart;
- PROCEDURE PieMenuOpen(sender, data: ANY);
- BEGIN
- Open(piemenu, piemenu.userData)
- END PieMenuOpen;
- PROCEDURE PieMenuCopy(sender, data: ANY);
- BEGIN
- CopySelection;
- END PieMenuCopy;
- PROCEDURE PieMenuPaste(sender, data: ANY);
- BEGIN
- Paste;
- END PieMenuPaste;
- PROCEDURE ShowContextMenu(x, y: LONGINT);
- VAR
- popup : WMPopups.Popup;
- start, end, bufSize : LONGINT;
- command, s : Strings.String;
- clickInfo : ClickInfo;
- str : ARRAY 256 OF CHAR;
- window : WMWindowManager.Window;
- nofLastSelections : LONGINT;
- BEGIN
- ASSERT(IsCallFromSequencer());
- text.AcquireRead;
- FindCommand(cursor.GetPosition(), start, end);
- bufSize := Strings.Max(Strings.Min((end - start) * 5 + 1 (* for UTF *), 4096), 1);
- NEW(command, bufSize);
- TextUtilities.SubTextToStr(text, start, end - start, command^);
- FindCommandRange(cursor.GetPosition(), start, end, nofLastSelections);
- bufSize := Strings.Max(Strings.Min((end - start) * 5 + 1 (* for UTF *), MaxCallParameterBuf), 1);
- NEW(s, bufSize);
- TextUtilities.SubTextToStr(text, start, end - start, s^);
- text.ReleaseRead;
- NEW(clickInfo);
- clickInfo.cmd := command;
- clickInfo.cmdPar := s;
- IF UsePieMenu THEN
- NEW(piemenu); piemenu.SetEnabled({0, 1, 2, 3});
- piemenu.SetText(1, Strings.NewString("Open"));
- piemenu.SetText(3, Strings.NewString("Start"));
- piemenu.SetText(2, Strings.NewString("Copy"));
- piemenu.SetText(0, Strings.NewString("Paste"));
- piemenu.userData := clickInfo;
- piemenu.on1.Add(PieMenuOpen);
- piemenu.on2.Add(PieMenuCopy);
- piemenu.on3.Add(PieMenuStart);
- piemenu.on0.Add(PieMenuPaste);
- manager := WMWindowManager.GetDefaultManager();
- window := manager.GetPositionOwner(x, y);
- IF window = NIL THEN RETURN END;
- Acquire; ToWMCoordinates(x, y, x, y); Release;
- piemenu.Show(window, x, y, FALSE);
- (* TODO: Can't set := NIL, since its used by the button handlers *)
- ELSE
- NEW(popup);
- str := "Start "; Strings.Append(str, command^); popup.AddParButton(str, Start, clickInfo);
- str := "Open "; Strings.Append(str, command^); popup.AddParButton(str, Open, clickInfo);
- Acquire; ToWMCoordinates(x, y, x, y); Release;
- popup.Popup(x, y);
- END
- END ShowContextMenu;
- PROCEDURE HandleInternal(VAR x: WMMessages.Message);
- VAR pos : LONGINT; obj : ANY; link : Texts.Link;
- BEGIN
- ASSERT(IsCallFromSequencer());
- IF (x.msgType = WMMessages.MsgKey) & objHasFocus THEN (* forward KeyMsg *)
- WITH focusObject : WMComponents.VisualComponent DO
- focusObject.Handle(x);
- InvalidateRange(focusPos, focusPos+1)
- END
- ELSIF (x.msgType # WMMessages.MsgKey) & HitObject(x.x, x.y, pos, obj) THEN (* forward Msg *)
- SetFocus; cursor.SetVisible(FALSE);
- IF obj IS WMComponents.VisualComponent THEN
- WITH obj : WMComponents.VisualComponent DO
- (* remove oldObject first *)
- IF (oldObject # NIL) & (oldObject # obj) THEN
- oldObject(WMComponents.VisualComponent).Handle(x);
- InvalidateRange(oldPos, oldPos+1);
- END;
- TransformCoordinates(x.x, x.y, obj); (* transform to obj coords *)
- obj.Handle(x); (* call obj Handle *)
- ChangePointer(obj.GetPointerInfo()); (* change the pointer Image *)
- InvalidateRange(pos, pos+1); (* redraw obj *)
- oldObject := obj; oldPos := pos; (* store last object *)
- (* transfer focus to Object *)
- IF (x.msgType = WMMessages.MsgPointer) & (x.flags * {0, 1, 2} = {0}) THEN
- (* remove old focus first *)
- IF (focusObject # NIL) & (focusObject # obj) THEN
- focusObject(WMComponents.VisualComponent).FocusLost;
- InvalidateRange(focusPos, focusPos+1)
- END;
- objHasFocus := TRUE;
- focusObject := obj; focusPos := pos;
- (* FocusLost *)
- END
- END
- END
- ELSIF (x.msgType = WMMessages.MsgPointer) & HitLink(x.x, x.y, pos, link) THEN (* Link *)
- ChangePointer(manager.pointerLink);
- IF (x.msgSubType = 2) &(oldFlags / x.flags = {CallURLPointer}) THEN LinkClick(link); END;
- oldFlags := x.flags;
- ELSE
- ChangePointer(manager.pointerText); (* change Pointer back *)
- (* transfer focus back to TextView *)
- IF (focusObject # NIL) & (x.msgType = WMMessages.MsgPointer) & (x.flags * {0, 1, 2} = {0}) THEN
- focusObject(WMComponents.VisualComponent).FocusLost;
- objHasFocus := FALSE;
- InvalidateRange(focusPos, focusPos+1);
- FocusReceived;
- focusObject := NIL
- END;
- (* update last Object *)
- IF (oldObject # NIL) & (x.msgType = WMMessages.MsgPointer) THEN
- oldObject(WMComponents.VisualComponent).Handle(x);
- InvalidateRange(oldPos, oldPos+1);
- oldObject := NIL
- END;
- IF (x.msgType = WMMessages.MsgExt) & (x.ext # NIL) & (x.ext IS Texts.StyleChangedMsg) THEN
- layout.FullLayout(TRUE); Invalidate; CheckNumberOfLines;
- ELSE
- HandleInternal^(x);
- END;
- END
- END HandleInternal;
- END TextView;
- TYPE
- FontEntry = OBJECT
- VAR
- name : ARRAY 256 OF CHAR;
- attributes : FontAttributes;
- next : FontEntry;
- PROCEDURE &Init(CONST name : ARRAY OF CHAR);
- BEGIN
- COPY(name, SELF.name);
- attributes := NIL;
- next := NIL;
- END Init;
- END FontEntry;
- FontAttributes = OBJECT
- VAR
- font : WMGraphics.Font; (* { font # {} *)
- size : LONGINT;
- style : SET;
- next : FontAttributes;
- PROCEDURE &Init(size : LONGINT; style : SET);
- BEGIN
- font := NIL;
- SELF.size := size;
- SELF.style := style;
- next := NIL;
- END Init;
- END FontAttributes;
- (* not thread-safe! not global to avoid locking and keep size smaller *)
- FontCache = OBJECT
- VAR
- entries : FontEntry;
- defaultFont : WMGraphics.Font;
- PROCEDURE &Init;
- BEGIN
- NEW(entries, "head"); (* head of list *)
- defaultFont := WMGraphics.GetDefaultFont();
- END Init;
- PROCEDURE Find(CONST name : ARRAY OF CHAR; size : LONGINT; style : SET) : WMGraphics.Font;
- VAR font : WMGraphics.Font; e : FontEntry; a : FontAttributes;
- BEGIN
- font := NIL;
- e := entries.next;
- WHILE (e # NIL ) & (e.name < name) DO e := e.next; END;
- IF (e # NIL) & (e.name = name) THEN
- a := e.attributes;
- WHILE (a # NIL) & (a.size < size) DO a := a.next; END;
- WHILE (a # NIL) & (a.size = size) & (a.style # style) DO a := a.next; END;
- IF (a # NIL) & (a.size = size) THEN
- ASSERT(a.font # NIL);
- font := a.font;
- END;
- END;
- RETURN font;
- END Find;
- PROCEDURE Add(CONST name : ARRAY OF CHAR; size : LONGINT; style : SET) : WMGraphics.Font;
- VAR entry, e : FontEntry; attribute, a : FontAttributes;
- BEGIN
- e := entries;
- WHILE (e.next # NIL) & (e.next.name < name) DO e := e.next; END;
- IF (e.next # NIL) & (e.next.name = name) THEN
- entry := e.next;
- ELSE
- NEW(entry, name);
- entry.next := e.next;
- e.next := entry;
- END;
- ASSERT(entry # NIL);
- NEW(attribute, size, style);
- attribute.font := WMGraphics.GetFont(name, size, style);
- IF (entry.attributes = NIL) THEN
- entry.attributes := attribute;
- ELSIF (entry.attributes.size >= attribute.size) THEN
- attribute.next := entry.attributes;
- entry.attributes := attribute;
- ELSE
- a := entry.attributes;
- WHILE (a.next # NIL) & (a.next.size < attribute.size) DO a := a.next; END;
- attribute.next := a.next;
- a.next := attribute;
- END;
- ASSERT(attribute.font # NIL);
- RETURN attribute.font;
- END Add;
- (* Get specified font. If not available, the system default font is returned *)
- PROCEDURE GetFont(CONST name : ARRAY OF CHAR; size : LONGINT; style : SET) : WMGraphics.Font;
- VAR font : WMGraphics.Font;
- BEGIN
- font := Find(name, size, style);
- IF (font = NIL) THEN
- font := Add(name, size, style);
- END;
- ASSERT(font # NIL);
- RETURN font;
- END GetFont;
- END FontCache;
- VAR
- manager : WMWindowManager.WindowManager;
- cursorBlinker- : CursorBlinker;
- PTVIsMultiLine, PTVIsPassword, PTVShowBorder, PTValwaysShowCursor, PTVShowLabels : WMProperties.BooleanProperty;
- PTVAllowCommandExecution, PTVAllowTextSelection, PTVAllowPiemenu : WMProperties.BooleanProperty;
- PTVWrapMode, PTVMouseWheelScrollSpeed, PVTtextAlignV : WMProperties.Int32Property;
- PTVfirstLine, PTVleftShift, PTVPasswordChar : WMProperties.Int32Property;
- PTVdefaultTextColor, PTVdefaultTextBgColor : WMProperties.ColorProperty;
- PTVborders : WMProperties.RectangleProperty;
- PTVonLinkClick, PTVonLinkClickInfo : Strings.String;
- PTVonCtrlLinkClick, PTVonCtrlLinkClickInfo : Strings.String;
- PTVShowLineNumbers, PTVIndicateTabs : WMProperties.BooleanProperty;
- PTVHighlighting : WMProperties.StringProperty;
- PTVLineNumberColor, PTVLineNumberBgColor, PTVclBgCurrentLine : WMProperties.ColorProperty;
- currentTextView : TextView;
- StrTextView : Strings.String;
- DefaultStyle : POINTER TO RECORD END;
- PROCEDURE Limit(x, min, max : LONGINT) : LONGINT;
- BEGIN
- IF x < min THEN x := min END;
- IF x > max THEN x := max END;
- RETURN x
- END Limit;
- (* Actually, this is a hack... but for now, do it. *)
- PROCEDURE GetNewSize(CONST fontname : ARRAY OF CHAR; value, currentSize : LONGINT; VAR newSize : LONGINT);
- BEGIN
- IF (fontname = "Oberon") THEN
- IF (value >0) THEN
- IF (currentSize <= 8) THEN newSize := 10;
- ELSIF (currentSize <= 10) THEN newSize := 12;
- ELSIF (currentSize <= 12) THEN newSize := 14;
- ELSIF (currentSize <= 14) THEN newSize := 16;
- ELSIF (currentSize <= 16) THEN newSize := 20;
- ELSIF (currentSize <= 20) THEN newSize := 24;
- ELSE (* go to default *)
- newSize := 24; (* max. size of Oberon font *)
- END;
- ELSE
- IF (currentSize >= 24) THEN newSize := 20;
- ELSIF (currentSize >= 20) THEN newSize := 16;
- ELSIF (currentSize >= 16) THEN newSize := 14;
- ELSIF (currentSize >= 14) THEN newSize := 12;
- ELSIF (currentSize >= 12) THEN newSize := 10;
- ELSE
- newSize := 8;
- END;
- END;
- ELSIF (fontname = "Courier") THEN
- IF (value > 0) THEN
- IF (currentSize <= 8) THEN newSize := 10;
- ELSE
- newSize := 12;
- END;
- ELSE
- IF (currentSize >= 12) THEN newSize := 10;
- ELSE
- newSize := 8;
- END;
- END;
- ELSE
- newSize := currentSize + value * currentSize DIV 4;
- END;
- IF (newSize < 8) THEN newSize := 8; END;
- TRACE(currentSize, value, newSize);
- END GetNewSize;
- TYPE
- DZ = OBJECT (Texts.Attributes);
- VAR value: LONGINT;
- PROCEDURE &Init(v: LONGINT);
- BEGIN
- value := v;
- END Init;
- END DZ;
- PROCEDURE EnsureAttribute(VAR attr : Texts.Attributes);
- BEGIN
- IF (attr = NIL) THEN
- NEW(attr); NEW(attr.fontInfo);
- attr.fontInfo.name := "Vera";
- attr.fontInfo.size := 16;
- attr.fontInfo.style := {};
- attr.color := 0000000FFH;
- attr.bgcolor := 000000000H;
- END
- END EnsureAttribute;
- PROCEDURE ChangeAttribute(VAR attr : Texts.Attributes; userData : ANY);
- VAR dz: DZ;
- BEGIN
- IF (userData # NIL) & (userData IS DZ) THEN
- EnsureAttribute(attr);
- dz := userData(DZ);
- GetNewSize(attr.fontInfo.name,-dz.value, attr.fontInfo.size, attr.fontInfo.size);
- attr.fontInfo.fontcache := NIL;
- END;
- END ChangeAttribute;
- PROCEDURE GetFontFromAttr(info : Texts.FontInfo) : WMGraphics.Font;
- BEGIN
- RETURN WMGraphics.GetFont(info.name, info.size, info.style);
- END GetFontFromAttr;
- PROCEDURE IsSameFont(f1, f2 : WMGraphics.Font) : BOOLEAN;
- BEGIN
- RETURN (f1 = f2) OR ((f1 # NIL) & (f2 # NIL) & (f1.size = f2.size) & (f1.style = f2.style) & (f1.name = f2.name));
- END IsSameFont;
- PROCEDURE CheckFont(style : SyntaxHighlighter.Style; font : WMGraphics.Font; VAR fontCache : FontCache);
- VAR fontname : ARRAY 256 OF CHAR; fontsize : LONGINT; fontstyle : SET;
- BEGIN
- ASSERT(style # NIL);
- IF (fontCache = NIL) THEN NEW(fontCache); END;
- IF (style.defined * SyntaxHighlighter.FontMask = SyntaxHighlighter.FontMask) OR (font = NIL) THEN
- COPY(style.attributes.fontInfo.name, fontname);
- fontsize := style.attributes.fontInfo.size;
- fontstyle := style.attributes.fontInfo.style;
- ELSIF (font # NIL) THEN
- IF (SyntaxHighlighter.FontName IN style.defined) THEN COPY(style.attributes.fontInfo.name, fontname); ELSE COPY(font.name, fontname); END;
- IF (SyntaxHighlighter.FontSize IN style.defined) THEN fontsize := style.attributes.fontInfo.size; ELSE fontsize := font.size; END;
- IF (SyntaxHighlighter.FontStyle IN style.defined) THEN fontstyle := style.attributes.fontInfo.style; ELSE fontstyle := font.style; END;
- END;
- IF (style.attributes.fontInfo.fontcache = NIL) OR ~IsSameFont(style.attributes.fontInfo.fontcache (WMGraphics.Font), font) THEN
- style.attributes.fontInfo.fontcache := fontCache.GetFont(fontname, fontsize, fontstyle);
- END;
- ASSERT(style.attributes.fontInfo.fontcache # NIL);
- END CheckFont;
- PROCEDURE InitStrings;
- BEGIN
- StrTextView := Strings.NewString("TextView");
- PTVonLinkClick := Strings.NewString("Link Click Event");
- PTVonLinkClickInfo := Strings.NewString("fired when a link is pressed");
- PTVonCtrlLinkClick := Strings.NewString("Ctrl Click Event");
- PTVonCtrlLinkClickInfo := Strings.NewString("fired when Ctrl pressend and clicked");
- END InitStrings;
- PROCEDURE InitPrototypes;
- BEGIN
- NEW(PTVIsMultiLine, NIL, Strings.NewString("multiLine"), Strings.NewString("defines if more than one line is visible"));
- PTVIsMultiLine.Set(TRUE);
- NEW(PTVShowBorder, NIL, Strings.NewString("ShowBorder"), Strings.NewString("show border"));
- PTVShowBorder.Set(FALSE);
- NEW(PTVIsPassword, NIL, Strings.NewString("password"),
- Strings.NewString("defines if the view is a password text. Characters are replaced by passwordChar"));
- NEW(PTVPasswordChar, NIL, Strings.NewString("passwordChar"),
- Strings.NewString("character that is the placeholder for a character in a password"));
- PTVPasswordChar.Set(43);
- NEW(PTValwaysShowCursor, NIL, Strings.NewString("alwaysShowCursor"),
- Strings.NewString("set to true, if the cursor should not be hidden when focus is lost"));
- PTValwaysShowCursor.Set(FALSE);
- NEW(PTVShowLabels, NIL, Strings.NewString("ShowLabels"),
- Strings.NewString("set to true, if the labels should be shown in the text"));
- PTVShowLabels.Set(FALSE);
- NEW(PTVMouseWheelScrollSpeed, NIL, Strings.NewString("MouseWheelScrollSpeed"),
- Strings.NewString("Multiplier for mouse wheel, 0 to disable mouse wheel scrolling"));
- PTVMouseWheelScrollSpeed.Set(3);
- NEW(PTVAllowCommandExecution, NIL, Strings.NewString("allowCommandExecution"),
- Strings.NewString("if set to true, middle-clicked words are executed as command"));
- PTVAllowCommandExecution.Set(TRUE);
- NEW(PTVAllowTextSelection, NIL, Strings.NewString("allowTextSelection"),
- Strings.NewString("is the user allowed to select text using the mouse?"));
- PTVAllowTextSelection.Set(TRUE);
- NEW(PTVAllowPiemenu, NIL, Strings.NewString("allowPiemenu"),
- Strings.NewString("if set to true, a mouse right-click opens the pie menu"));
- PTVAllowPiemenu.Set(TRUE);
- NEW(PTVWrapMode, NIL, Strings.NewString("wrapMode"), Strings.NewString("Set text wrapping mode"));
- PTVWrapMode.Set(WrapWord);
- NEW(PTVfirstLine, NIL, Strings.NewString("firstLine"),
- Strings.NewString("the first visible line of text in the view"));
- PTVfirstLine.Set(0);
- NEW(PTVleftShift, NIL, Strings.NewString("leftShift"),
- Strings.NewString("how many pixels the text in the view is shifted to the left"));
- PTVleftShift.Set(0);
- NEW(PTVdefaultTextColor, NIL, Strings.NewString("defaultTextColor"),
- Strings.NewString("the color of a text that does not explicitly specify a color"));
- PTVdefaultTextColor.Set(0FFH);
- NEW(PTVdefaultTextBgColor, NIL, Strings.NewString("defaultTextBgColor"),
- Strings.NewString("The color of a text background if not specified otherwise in the text"));
- PTVdefaultTextBgColor.Set(0);
- NEW(PTVborders, NIL, Strings.NewString("borders"),
- Strings.NewString("spaces from bounds of the component to the text"));
- PTVborders.Set(WMRectangles.MakeRect(5, 5, 5, 5));
- NEW(PTVIndicateTabs, NIL, Strings.NewString("IndicateTabs"), Strings.NewString("Indicate tabs?"));
- PTVIndicateTabs.Set(FALSE);
- NEW(PTVShowLineNumbers, NIL, Strings.NewString("ShowLineNumbers"), Strings.NewString("Show line numbers?"));
- PTVShowLineNumbers.Set(FALSE);
- NEW(PTVLineNumberColor, NIL, Strings.NewString("LineNumberColor"), Strings.NewString("Color of line numbers"));
- PTVLineNumberColor.Set(WMGraphics.Black);
- NEW(PTVLineNumberBgColor, NIL, Strings.NewString("LineNumberBgColor"), Strings.NewString("Background color of line numbers"));
- PTVLineNumberBgColor.Set(0CCCCCCFFH);
- NEW(PTVHighlighting, NIL, Strings.NewString("Highlighting"), Strings.NewString("Name of highlighting to be applied"));
- PTVHighlighting.Set(NIL);
- NEW(PTVclBgCurrentLine, NIL, Strings.NewString("ClBgCurrentLine"), Strings.NewString("Background color of currently edited line"));
- PTVclBgCurrentLine.Set(0);
- NEW(PVTtextAlignV, NIL, Strings.NewString("TextAlignV"), Strings.NewString("vertical Text Alignment"));
- PVTtextAlignV.Set(WMGraphics.AlignTop);
- END InitPrototypes;
- PROCEDURE EnablePiemenu*;
- BEGIN
- PTVAllowPiemenu.Set( TRUE );
- KernelLog.String( "Piemenu enabled" ); KernelLog.Ln
- END EnablePiemenu;
- PROCEDURE DisablePiemenu*;
- BEGIN
- PTVAllowPiemenu.Set( FALSE );
- KernelLog.String( "Piemenu disabled" ); KernelLog.Ln
- END DisablePiemenu;
- PROCEDURE TextViewFactory*() : XML.Element;
- VAR e : TextView;
- BEGIN
- NEW(e); RETURN e
- END TextViewFactory;
- (* Inserts a ocharacter from the outside into the current textView's text at its current position *)
- PROCEDURE InsertChar*(newChar : Char32) : INTEGER;
- BEGIN
- IF currentTextView # NIL THEN
- RETURN currentTextView.InsertChar(newChar);
- ELSE
- RETURN -3;
- END;
- END InsertChar;
- PROCEDURE Refresh*;
- BEGIN
- IF currentTextView # NIL THEN
- currentTextView.layout.FullLayout(TRUE);
- currentTextView.Invalidate;
- currentTextView.CheckNumberOfLines;
- END;
- END Refresh;
- PROCEDURE Cleanup;
- BEGIN
- cursorBlinker.Finalize;
- END Cleanup;
- PROCEDURE GenTextView*(): XML.Element;
- VAR e : TextView;
- BEGIN
- NEW(e); RETURN e
- END GenTextView;
- BEGIN
- NEW(cursorBlinker);
- NEW(DefaultStyle);
- Modules.InstallTermHandler(Cleanup);
- InitStrings;
- InitPrototypes;
- manager := WMWindowManager.GetDefaultManager();
- END WMTextView.
|