12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797 |
- unit Editors;
- {$i platform.inc}
- {$ifdef PPC_FPC}
- {$H-}
- {$else}
- {$F+,O+,E+,N+}
- {$endif}
- {$X+,R-,I-,Q-,V-}
- {$ifndef OS_UNIX}
- {$S-}
- {$endif}
- {$define UNIXLF}
- {2.0 compatibility}
- {$ifdef VER2_0}
- {$macro on}
- {$define resourcestring := const}
- {$endif}
- interface
- uses
- Objects, Drivers,Views,Dialogs,FVCommon,FVConsts;
- const
- { Length constants. }
- Tab_Stop_Length = 74;
- {$ifdef PPC_BP}
- MaxLineLength = 1024;
- MinBufLength = $1000;
- MaxBufLength = $ff00;
- NotFoundValue = $ffff;
- LineInfoGrow = 256;
- MaxLines = 16000;
- {$else}
- MaxLineLength = 4096;
- MinBufLength = $1000;
- MaxBufLength = $7fffff00;
- NotFoundValue = $ffffffff;
- LineInfoGrow = 1024;
- MaxLines = $7ffffff;
- {$endif}
- { Editor constants for dialog boxes. }
- edOutOfMemory = 0;
- edReadError = 1;
- edWriteError = 2;
- edCreateError = 3;
- edSaveModify = 4;
- edSaveUntitled = 5;
- edSaveAs = 6;
- edFind = 7;
- edSearchFailed = 8;
- edReplace = 9;
- edReplacePrompt = 10;
- edJumpToLine = 11;
- edPasteNotPossible = 12;
- edReformatDocument = 13;
- edReformatNotAllowed = 14;
- edReformNotPossible = 15;
- edReplaceNotPossible = 16;
- edRightMargin = 17;
- edSetTabStops = 18;
- edWrapNotPossible = 19;
- { Editor flag constants for dialog options. }
- efCaseSensitive = $0001;
- efWholeWordsOnly = $0002;
- efPromptOnReplace = $0004;
- efReplaceAll = $0008;
- efDoReplace = $0010;
- efBackupFiles = $0100;
- { Constants for object palettes. }
- CIndicator = #2#3;
- CEditor = #6#7;
- CMemo = #26#27;
- type
- TEditorDialog = function (Dialog : Integer; Info : Pointer) : Word;
- PIndicator = ^TIndicator;
- TIndicator = object (TView)
- Location : Objects.TPoint;
- Modified : Boolean;
- AutoIndent : Boolean; { Added boolean for AutoIndent mode. }
- WordWrap : Boolean; { Added boolean for WordWrap mode. }
- constructor Init (var Bounds : TRect);
- procedure Draw; virtual;
- function GetPalette : PPalette; virtual;
- procedure SetState (AState : Word; Enable : Boolean); virtual;
- procedure SetValue (ALocation : Objects.TPoint; IsAutoIndent : Boolean;
- IsModified : Boolean;
- IsWordWrap : Boolean);
- end;
- TLineInfoRec = record
- Len,Attr : Sw_word;
- end;
- TLineInfoArr = array[0..MaxLines] of TLineInfoRec;
- PLineInfoArr = ^TLineInfoArr;
- PLineInfo = ^TLineInfo;
- TLineInfo = object
- Info : PLineInfoArr;
- MaxPos : Sw_Word;
- constructor Init;
- destructor Done;
- procedure Grow(pos:Sw_word);
- procedure SetLen(pos,val:Sw_Word);
- procedure SetAttr(pos,val:Sw_Word);
- function GetLen(pos:Sw_Word):Sw_Word;
- function GetAttr(pos:Sw_Word):Sw_Word;
- end;
- PEditBuffer = ^TEditBuffer;
- TEditBuffer = array[0..MaxBufLength] of Char;
- PEditor = ^TEditor;
- TEditor = object (TView)
- HScrollBar : PScrollBar;
- VScrollBar : PScrollBar;
- Indicator : PIndicator;
- Buffer : PEditBuffer;
- BufSize : Sw_Word;
- BufLen : Sw_Word;
- GapLen : Sw_Word;
- SelStart : Sw_Word;
- SelEnd : Sw_Word;
- CurPtr : Sw_Word;
- CurPos : Objects.TPoint;
- Delta : Objects.TPoint;
- Limit : Objects.TPoint;
- DrawLine : Sw_Integer;
- DrawPtr : Sw_Word;
- DelCount : Sw_Word;
- InsCount : Sw_Word;
- Flags : Longint;
- IsReadOnly : Boolean;
- IsValid : Boolean;
- CanUndo : Boolean;
- Modified : Boolean;
- Selecting : Boolean;
- Overwrite : Boolean;
- AutoIndent : Boolean;
- NoSelect : Boolean;
- TabSize : Sw_Word; { tabsize for displaying }
- BlankLine : Sw_Word; { First blank line after a paragraph. }
- Word_Wrap : Boolean; { Added boolean to toggle wordwrap on/off. }
- Line_Number : string[8]; { Holds line number to jump to. }
- Right_Margin : Sw_Integer; { Added integer to set right margin. }
- Tab_Settings : String[Tab_Stop_Length]; { Added string to hold tab stops. }
- constructor Init (var Bounds : TRect; AHScrollBar, AVScrollBar : PScrollBar;
- AIndicator : PIndicator; ABufSize : Sw_Word);
- constructor Load (var S : Objects.TStream);
- destructor Done; virtual;
- function BufChar (P : Sw_Word) : Char;
- function BufPtr (P : Sw_Word) : Sw_Word;
- procedure ChangeBounds (var Bounds : TRect); virtual;
- procedure ConvertEvent (var Event : Drivers.TEvent); virtual;
- function CursorVisible : Boolean;
- procedure DeleteSelect;
- procedure DoneBuffer; virtual;
- procedure Draw; virtual;
- procedure FormatLine (var DrawBuf; LinePtr : Sw_Word; Width : Sw_Integer; Colors : Word);virtual;
- function GetPalette : PPalette; virtual;
- procedure HandleEvent (var Event : Drivers.TEvent); virtual;
- procedure InitBuffer; virtual;
- function InsertBuffer (var P : PEditBuffer; Offset, Length : Sw_Word;AllowUndo, SelectText : Boolean) : Boolean;
- function InsertFrom (Editor : PEditor) : Boolean; virtual;
- function InsertText (Text : Pointer; Length : Sw_Word; SelectText : Boolean) : Boolean;
- procedure ScrollTo (X, Y : Sw_Integer);
- function Search (const FindStr : String; Opts : Word) : Boolean;
- function SetBufSize (NewSize : Sw_Word) : Boolean; virtual;
- procedure SetCmdState (Command : Word; Enable : Boolean);
- procedure SetSelect (NewStart, NewEnd : Sw_Word; CurStart : Boolean);
- procedure SetCurPtr (P : Sw_Word; SelectMode : Byte);
- procedure SetState (AState : Word; Enable : Boolean); virtual;
- procedure Store (var S : Objects.TStream);
- procedure TrackCursor (Center : Boolean);
- procedure Undo;
- procedure UpdateCommands; virtual;
- function Valid (Command : Word) : Boolean; virtual;
- private
- KeyState : Integer;
- LockCount : Byte;
- UpdateFlags : Byte;
- Place_Marker : Array [1..10] of Sw_Word; { Inserted array to hold place markers. }
- Search_Replace : Boolean; { Added boolean to test for Search and Replace insertions. }
- procedure Center_Text (Select_Mode : Byte);
- function CharPos (P, Target : Sw_Word) : Sw_Integer;
- function CharPtr (P : Sw_Word; Target : Sw_Integer) : Sw_Word;
- procedure Check_For_Word_Wrap (Select_Mode : Byte; Center_Cursor : Boolean);
- function ClipCopy : Boolean;
- procedure ClipCut;
- procedure ClipPaste;
- procedure DeleteRange (StartPtr, EndPtr : Sw_Word; DelSelect : Boolean);
- procedure DoSearchReplace;
- procedure DoUpdate;
- function Do_Word_Wrap (Select_Mode : Byte; Center_Cursor : Boolean) : Boolean;
- procedure DrawLines (Y, Count : Sw_Integer; LinePtr : Sw_Word);
- procedure Find;
- function GetMousePtr (Mouse : Objects.TPoint) : Sw_Word;
- function HasSelection : Boolean;
- procedure HideSelect;
- procedure Insert_Line (Select_Mode : Byte);
- function IsClipboard : Boolean;
- procedure Jump_Place_Marker (Element : Byte; Select_Mode : Byte);
- procedure Jump_To_Line (Select_Mode : Byte);
- function LineEnd (P : Sw_Word) : Sw_Word;
- function LineMove (P : Sw_Word; Count : Sw_Integer) : Sw_Word;
- function LineStart (P : Sw_Word) : Sw_Word;
- function LineNr (P : Sw_Word) : Sw_Word;
- procedure Lock;
- function NewLine (Select_Mode : Byte) : Boolean;
- function NextChar (P : Sw_Word) : Sw_Word;
- function NextLine (P : Sw_Word) : Sw_Word;
- function NextWord (P : Sw_Word) : Sw_Word;
- function PrevChar (P : Sw_Word) : Sw_Word;
- function PrevLine (P : Sw_Word) : Sw_Word;
- function PrevWord (P : Sw_Word) : Sw_Word;
- procedure Reformat_Document (Select_Mode : Byte; Center_Cursor : Boolean);
- function Reformat_Paragraph (Select_Mode : Byte; Center_Cursor : Boolean) : Boolean;
- procedure Remove_EOL_Spaces (Select_Mode : Byte);
- procedure Replace;
- procedure Scroll_Down;
- procedure Scroll_Up;
- procedure Select_Word;
- procedure SetBufLen (Length : Sw_Word);
- procedure Set_Place_Marker (Element : Byte);
- procedure Set_Right_Margin;
- procedure Set_Tabs;
- procedure StartSelect;
- procedure Tab_Key (Select_Mode : Byte);
- procedure ToggleInsMode;
- procedure Unlock;
- procedure Update (AFlags : Byte);
- procedure Update_Place_Markers (AddCount : Word; KillCount : Word; StartPtr,EndPtr : Sw_Word);
- end;
- TMemoData = record
- Length : Sw_Word;
- Buffer : TEditBuffer;
- end;
- PMemo = ^TMemo;
- TMemo = object (TEditor)
- constructor Load (var S : Objects.TStream);
- function DataSize : Sw_Word; virtual;
- procedure GetData (var Rec); virtual;
- function GetPalette : PPalette; virtual;
- procedure HandleEvent (var Event : Drivers.TEvent); virtual;
- procedure SetData (var Rec); virtual;
- procedure Store (var S : Objects.TStream);
- end;
- PFileEditor = ^TFileEditor;
- TFileEditor = object (TEditor)
- FileName : FNameStr;
- constructor Init (var Bounds : TRect; AHScrollBar, AVScrollBar : PScrollBar;
- AIndicator : PIndicator; AFileName : FNameStr);
- constructor Load (var S : Objects.TStream);
- procedure DoneBuffer; virtual;
- procedure HandleEvent (var Event : Drivers.TEvent); virtual;
- procedure InitBuffer; virtual;
- function LoadFile : Boolean;
- function Save : Boolean;
- function SaveAs : Boolean;
- function SaveFile : Boolean;
- function SetBufSize (NewSize : Sw_Word) : Boolean; virtual;
- procedure Store (var S : Objects.TStream);
- procedure UpdateCommands; virtual;
- function Valid (Command : Word) : Boolean; virtual;
- end;
- PEditWindow = ^TEditWindow;
- TEditWindow = object (TWindow)
- Editor : PFileEditor;
- constructor Init (var Bounds : TRect; FileName : FNameStr; ANumber : Integer);
- constructor Load (var S : Objects.TStream);
- procedure Close; virtual;
- function GetTitle (MaxSize : Sw_Integer) : TTitleStr; virtual;
- procedure HandleEvent (var Event : Drivers.TEvent); virtual;
- procedure SizeLimits(var Min, Max: TPoint); virtual;
- procedure Store (var S : Objects.TStream);
- end;
- function DefEditorDialog (Dialog : Integer; Info : Pointer) : Word;
- function CreateFindDialog: PDialog;
- function CreateReplaceDialog: PDialog;
- function JumpLineDialog : PDialog;
- function ReformDocDialog : PDialog;
- function RightMarginDialog : PDialog;
- function TabStopDialog : Dialogs.PDialog;
- function StdEditorDialog(Dialog: Integer; Info: Pointer): Word;
- const
- WordChars : set of Char = ['!'..#255];
- LineBreak : string[2]=
- {$ifdef UNIXLF}
- #10;
- {$else}
- #13#10;
- {$endif}
- { The Allow_Reformat boolean is a programmer hook. }
- { I've placed this here to allow programmers to }
- { determine whether or not paragraph and document }
- { reformatting are allowed if Word_Wrap is not }
- { active. Some people say don't allow, and others }
- { say allow it. I've left it up to the programmer. }
- { Set to FALSE if not allowed, or TRUE if allowed. }
- Allow_Reformat : Boolean = True;
- EditorDialog : TEditorDialog = {$ifdef fpc}@{$endif}DefEditorDialog;
- EditorFlags : Word = efBackupFiles + efPromptOnReplace;
- FindStr : String[80] = '';
- ReplaceStr : String[80] = '';
- Clipboard : PEditor = nil;
- ToClipCmds : TCommandSet = ([cmCut,cmCopy,cmClear]);
- FromClipCmds : TCommandSet = ([cmPaste]);
- UndoCmds : TCommandSet = ([cmUndo,cmRedo]);
- TYPE
- TFindDialogRec =
- {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
- packed
- {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
- record
- Find : String[80];
- Options : Word;
- end;
- TReplaceDialogRec =
- {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
- packed
- {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
- record
- Find : String[80];
- Replace : String[80];
- Options : Word;
- end;
- TRightMarginRec =
- {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
- packed
- {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
- record
- Margin_Position : String[3];
- end;
- TTabStopRec =
- {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
- packed
- {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
- record
- Tab_String : String [Tab_Stop_Length];
- end;
- CONST
- { VMT constants. }
- REditor : TStreamRec = (ObjType : 70;
- VmtLink : Ofs (TypeOf (TEditor)^);
- Load : @TEditor.Load;
- Store : @TEditor.Store);
- RMemo : TStreamRec = (ObjType : 71;
- VmtLink : Ofs (TypeOf (TMemo)^);
- Load : @TMemo.Load;
- Store : @TMemo.Store);
- RFileEditor : TStreamRec = (ObjType : 72;
- VmtLink : Ofs (TypeOf (TFileEditor)^);
- Load : @TFileEditor.Load;
- Store : @TFileEditor.Store);
- RIndicator : TStreamRec = (ObjType : 73;
- VmtLink : Ofs (TypeOf (TIndicator)^);
- Load : @TIndicator.Load;
- Store : @TIndicator.Store);
- REditWindow : TStreamRec = (ObjType : 74;
- VmtLink : Ofs (TypeOf (TEditWindow)^);
- Load : @TEditWindow.Load;
- Store : @TEditWindow.Store);
- procedure RegisterEditors;
- {****************************************************************************
- Implementation
- ****************************************************************************}
- implementation
- uses
- Dos, App, StdDlg, MsgBox{, Resource};
- type
- pword = ^word;
- resourcestring sClipboard='Clipboard';
- sFileCreateError='Error creating file %s';
- sFileReadError='Error reading file %s';
- sFileUntitled='Save untitled file?';
- sFileWriteError='Error writing to file %s';
- sFind='Find';
- sJumpTo='Jump To';
- sModified=''#3'%s'#13#10#13#3'has been modified. Save?';
- sOutOfMemory='Not enough memory for this operation.';
- sPasteNotPossible='Wordwrap on: Paste not possible in current margins when at end of line.';
- sReformatDocument='Reformat Document';
- sReformatNotPossible='Paragraph reformat not possible while trying to wrap current line with current margins.';
- sReformattingTheDocument='Reformatting the document:';
- sReplaceNotPossible='Wordwrap on: Replace not possible in current margins when at end of line.';
- sReplaceThisOccurence='Replace this occurence?';
- sRightMargin='Right Margin';
- sSearchStringNotFound='Search string not found.';
- sSelectWhereToBegin='Please select where to begin.';
- sSetting='Setting:';
- sTabSettings='Tab Settings';
- sUnknownDialog='Unknown dialog requested!';
- sUntitled='Untitled';
- sWordWrapNotPossible='Wordwrap on: Wordwrap not possible in current margins with continuous line.';
- sWordWrapOff='You must turn on wordwrap before you can reformat.';
- slCaseSensitive='~C~ase sensitive';
- slCurrentLine='~C~urrent line';
- slEntireDocument='~E~ntire document';
- slLineNumber='~L~ine number';
- slNewText='~N~ew text';
- slPromptOnReplace='~P~rompt on replace';
- slReplace='~R~eplace';
- slReplaceAll='~R~eplace all';
- slTextToFind='~T~ext to find';
- slWholeWordsOnly='~W~hole words only';
- CONST
- { Update flag constants. }
- ufUpdate = $01;
- ufLine = $02;
- ufView = $04;
- ufStats = $05;
- { SelectMode constants. }
- smExtend = $01;
- smDouble = $02;
- sfSearchFailed = NotFoundValue;
- { Arrays that hold all the command keys and options. }
- FirstKeys : array[0..46 * 2] of Word = (46, Ord (^A), cmWordLeft,
- Ord (^B), cmReformPara,
- Ord (^C), cmPageDown,
- Ord (^D), cmCharRight,
- Ord (^E), cmLineUp,
- Ord (^F), cmWordRight,
- Ord (^G), cmDelChar,
- Ord (^H), cmBackSpace,
- Ord (^I), cmTabKey,
- Ord (^J), $FF04,
- Ord (^K), $FF02,
- Ord (^L), cmSearchAgain,
- Ord (^M), cmNewLine,
- Ord (^N), cmInsertLine,
- Ord (^O), $FF03,
- Ord (^Q), $FF01,
- Ord (^R), cmPageUp,
- Ord (^S), cmCharLeft,
- Ord (^T), cmDelWord,
- Ord (^U), cmUndo,
- Ord (^V), cmInsMode,
- Ord (^W), cmScrollUp,
- Ord (^X), cmLineDown,
- Ord (^Y), cmDelLine,
- Ord (^Z), cmScrollDown,
- kbLeft, cmCharLeft,
- kbRight, cmCharRight,
- kbCtrlLeft, cmWordLeft,
- kbCtrlRight, cmWordRight,
- kbHome, cmLineStart,
- kbEnd, cmLineEnd,
- kbCtrlHome, cmHomePage,
- kbCtrlEnd, cmEndPage,
- kbUp, cmLineUp,
- kbDown, cmLineDown,
- kbPgUp, cmPageUp,
- kbPgDn, cmPageDown,
- kbCtrlPgUp, cmTextStart,
- kbCtrlPgDn, cmTextEnd,
- kbIns, cmInsMode,
- kbDel, cmDelChar,
- kbCtrlBack, cmDelStart,
- kbShiftIns, cmPaste,
- kbShiftDel, cmCut,
- kbCtrlIns, cmCopy,
- kbCtrlDel, cmClear);
- { SCRLUP - Stop. } { Added ^W to scroll screen up. }
- { SCRLDN - Stop. } { Added ^Z to scroll screen down. }
- { REFORM - Stop. } { Added ^B for paragraph reformatting. }
- { PRETAB - Stop. } { Added ^I for preset tabbing. }
- { JLINE - Stop. } { Added ^J to jump to a line number. }
- { INSLIN - Stop. } { Added ^N to insert line at cursor. }
- { INDENT - Stop. } { Removed ^O and put it into ^QI. }
- { HOMEND - Stop. } { Added kbCtrlHome and kbCtrlEnd pages. }
- { CTRLBK - Stop. } { Added kbCtrlBack same as ^QH. }
- QuickKeys : array[0..21 * 2] of Word = (21, Ord ('0'), cmJumpMark0,
- Ord ('1'), cmJumpMark1,
- Ord ('2'), cmJumpMark2,
- Ord ('3'), cmJumpMark3,
- Ord ('4'), cmJumpMark4,
- Ord ('5'), cmJumpMark5,
- Ord ('6'), cmJumpMark6,
- Ord ('7'), cmJumpMark7,
- Ord ('8'), cmJumpMark8,
- Ord ('9'), cmJumpMark9,
- Ord ('A'), cmReplace,
- Ord ('C'), cmTextEnd,
- Ord ('D'), cmLineEnd,
- Ord ('F'), cmFind,
- Ord ('H'), cmDelStart,
- Ord ('I'), cmIndentMode,
- Ord ('L'), cmUndo,
- Ord ('R'), cmTextStart,
- Ord ('S'), cmLineStart,
- Ord ('U'), cmReformDoc,
- Ord ('Y'), cmDelEnd);
- { UNDO - Stop. } { Added IDE undo feature of ^QL. }
- { REFDOC - Stop. } { Added document reformat feature if ^QU pressed. }
- { MARK - Stop. } { Added cmJumpMark# to allow place marking. }
- { INDENT - Stop. } { Moved IndentMode here from Firstkeys. }
- BlockKeys : array[0..20 * 2] of Word = (20, Ord ('0'), cmSetMark0,
- Ord ('1'), cmSetMark1,
- Ord ('2'), cmSetMark2,
- Ord ('3'), cmSetMark3,
- Ord ('4'), cmSetMark4,
- Ord ('5'), cmSetMark5,
- Ord ('6'), cmSetMark6,
- Ord ('7'), cmSetMark7,
- Ord ('8'), cmSetMark8,
- Ord ('9'), cmSetMark9,
- Ord ('B'), cmStartSelect,
- Ord ('C'), cmPaste,
- Ord ('D'), cmSave,
- Ord ('F'), cmSaveAs,
- Ord ('H'), cmHideSelect,
- Ord ('K'), cmCopy,
- Ord ('S'), cmSave,
- Ord ('T'), cmSelectWord,
- Ord ('Y'), cmCut,
- Ord ('X'), cmSaveDone);
- { SELWRD - Stop. } { Added ^KT to select word only. }
- { SAVE - Stop. } { Added ^KD, ^KF, ^KS, ^KX key commands. }
- { MARK - Stop. } { Added cmSetMark# to allow place marking. }
- FormatKeys : array[0..5 * 2] of Word = (5, Ord ('C'), cmCenterText,
- Ord ('T'), cmCenterText,
- Ord ('I'), cmSetTabs,
- Ord ('R'), cmRightMargin,
- Ord ('W'), cmWordWrap);
- { WRAP - Stop. } { Added Wordwrap feature if ^OW pressed. }
- { RMSET - Stop. } { Added set right margin feature if ^OR pressed. }
- { PRETAB - Stop. } { Added preset tab feature if ^OI pressed. }
- { CENTER - Stop. } { Added center text option ^OC for a line. }
- JumpKeys : array[0..1 * 2] of Word = (1, Ord ('L'), cmJumpLine);
- { JLINE - Stop. } { Added jump to line number feature if ^JL pressed. }
- KeyMap : array[0..4] of Pointer = (@FirstKeys,
- @QuickKeys,
- @BlockKeys,
- @FormatKeys,
- @JumpKeys);
- { WRAP - Stop. } { Added @FormatKeys for new ^O? keys. }
- { PRETAB - Stop. } { Added @FormatKeys for new ^O? keys. }
- { JLINE - Stop. } { Added @JumpKeys for new ^J? keys. }
- { CENTER - Stop. } { Added @FormatKeys for new ^O? keys. }
- {****************************************************************************
- Dialogs
- ****************************************************************************}
- function DefEditorDialog (Dialog : Integer; Info : Pointer) : Word;
- begin
- DefEditorDialog := cmCancel;
- end; { DefEditorDialog }
- function CreateFindDialog: PDialog;
- var
- D: PDialog;
- Control: PView;
- R: TRect;
- begin
- R.Assign(0, 0, 38, 12);
- D := New(PDialog, Init(R,sFind));
- with D^ do
- begin
- Options := Options or ofCentered;
- R.Assign(3, 3, 32, 4);
- Control := New(PInputLine, Init(R, 80));
- Control^.HelpCtx := hcDFindText;
- Insert(Control);
- R.Assign(2, 2, 15, 3);
- Insert(New(PLabel, Init(R, slTextToFind, Control)));
- R.Assign(32, 3, 35, 4);
- Insert(New(PHistory, Init(R, PInputLine(Control), 10)));
- R.Assign(3, 5, 35, 7);
- Control := New(PCheckBoxes, Init(R,
- NewSItem (slCaseSensitive,
- NewSItem (slWholeWordsOnly,nil))));
- Control^.HelpCtx := hcCCaseSensitive;
- Insert(Control);
- R.Assign(14, 9, 24, 11);
- Control := New (PButton, Init(R,slOK,cmOk,bfDefault));
- Control^.HelpCtx := hcDOk;
- Insert (Control);
- Inc(R.A.X, 12); Inc(R.B.X, 12);
- Control := New (PButton, Init(R,slCancel,cmCancel, bfNormal));
- Control^.HelpCtx := hcDCancel;
- Insert (Control);
- SelectNext(False);
- end;
- CreateFindDialog := D;
- end;
- function CreateReplaceDialog: PDialog;
- var
- D: PDialog;
- Control: PView;
- R: TRect;
- begin
- R.Assign(0, 0, 40, 16);
- D := New(PDialog, Init(R,slReplace));
- with D^ do
- begin
- Options := Options or ofCentered;
- R.Assign(3, 3, 34, 4);
- Control := New(PInputLine, Init(R, 80));
- Control^.HelpCtx := hcDFindText;
- Insert(Control);
- R.Assign(2, 2, 15, 3);
- Insert(New(PLabel, Init(R,slTextToFind, Control)));
- R.Assign(34, 3, 37, 4);
- Insert(New(PHistory, Init(R, PInputLine(Control), 10)));
- R.Assign(3, 6, 34, 7);
- Control := New(PInputLine, Init(R, 80));
- Control^.HelpCtx := hcDReplaceText;
- Insert(Control);
- R.Assign(2, 5, 12, 6);
- Insert(New(PLabel, Init(R,slNewText, Control)));
- R.Assign(34, 6, 37, 7);
- Insert(New(PHistory, Init(R, PInputLine(Control), 11)));
- R.Assign(3, 8, 37, 12);
- Control := New (Dialogs.PCheckBoxes, Init (R,
- NewSItem (slCasesensitive,
- NewSItem (slWholewordsonly,
- NewSItem (slPromptonreplace,
- NewSItem (slReplaceall, nil))))));
- Control^.HelpCtx := hcCCaseSensitive;
- Insert (Control);
- R.Assign (8, 13, 18, 15);
- Control := New (PButton, Init (R,slOK, cmOk, bfDefault));
- Control^.HelpCtx := hcDOk;
- Insert (Control);
- R.Assign (22, 13, 32, 15);
- Control := New (PButton, Init (R,slCancel, cmCancel, bfNormal));
- Control^.HelpCtx := hcDCancel;
- Insert (Control);
- SelectNext(False);
- end;
- CreateReplaceDialog := D;
- end;
- function JumpLineDialog : PDialog;
- VAR
- D : PDialog;
- R : TRect;
- Control: PView;
- Begin
- R.Assign (0, 0, 26, 8);
- D := New(PDialog, Init(R,sJumpTo));
- with D^ do
- begin
- Options := Options or ofCentered;
- R.Assign (3, 2, 15, 3);
- Control := New (Dialogs.PStaticText, Init (R,slLineNumber));
- Insert (Control);
- R.Assign (15, 2, 21, 3);
- Control := New (Dialogs.PInputLine, Init (R, 4));
- Control^.HelpCtx := hcDLineNumber;
- Insert (Control);
- R.Assign (21, 2, 24, 3);
- Insert (New (Dialogs.PHistory, Init (R, Dialogs.PInputLine (Control), 12)));
- R.Assign (2, 5, 12, 7);
- Control := New (Dialogs.PButton, Init (R, slOK, cmOK, Dialogs.bfDefault));
- Control^.HelpCtx := hcDOk;
- Insert (Control);
- R.Assign (14, 5, 24, 7);
- Control := New (Dialogs.PButton, Init (R, slCancel, cmCancel, Dialogs.bfNormal));
- Control^.HelpCtx := hcDCancel;
- Insert (Control);
- SelectNext (False);
- end;
- JumpLineDialog := D;
- end; { JumpLineDialog }
- function ReformDocDialog : Dialogs.PDialog;
- { This is a local function that brings up a dialog box }
- { that asks where to start reformatting the document. }
- VAR
- R : TRect;
- D : Dialogs.PDialog;
- Control : PView;
- Begin
- R.Assign (0, 0, 32, 11);
- D := New (Dialogs.PDialog, Init (R, sReformatDocument));
- with D^ do
- begin
- Options := Options or ofCentered;
- R.Assign (2, 2, 30, 3);
- Control := New (Dialogs.PStaticText, Init (R, sSelectWhereToBegin));
- Insert (Control);
- R.Assign (3, 3, 29, 4);
- Control := New (Dialogs.PStaticText, Init (R, sReformattingTheDocument));
- Insert (Control);
- R.Assign (50, 5, 68, 6);
- Control := New (Dialogs.PLabel, Init (R, sReformatDocument, Control));
- Insert (Control);
- R.Assign (5, 5, 26, 7);
- Control := New (Dialogs.PRadioButtons, Init (R,
- NewSItem (slCurrentLine,
- NewSItem (slEntireDocument, Nil))));
- Control^.HelpCtx := hcDReformDoc;
- Insert (Control);
- R.Assign (4, 8, 14, 10);
- Control := New (Dialogs.PButton, Init (R, slOK, cmOK, Dialogs.bfDefault));
- Control^.HelpCtx := hcDOk;
- Insert (Control);
- R.Assign (17, 8, 27, 10);
- Control := New (Dialogs.PButton, Init (R, slCancel, cmCancel, Dialogs.bfNormal));
- Control^.HelpCtx := hcDCancel;
- Insert (Control);
- SelectNext (False);
- end;
- ReformDocDialog := D;
- end; { ReformDocDialog }
- function RightMarginDialog : Dialogs.PDialog;
- { This is a local function that brings up a dialog box }
- { that allows the user to change the Right_Margin. }
- VAR
- R : TRect;
- D : PDialog;
- Control : PView;
- Begin
- R.Assign (0, 0, 26, 8);
- D := New (Dialogs.PDialog, Init (R, sRightMargin));
- with D^ do
- begin
- Options := Options or ofCentered;
- R.Assign (5, 2, 13, 3);
- Control := New (Dialogs.PStaticText, Init (R, sSetting));
- Insert (Control);
- R.Assign (13, 2, 18, 3);
- Control := New (Dialogs.PInputLine, Init (R, 3));
- Control^.HelpCtx := hcDRightMargin;
- Insert (Control);
- R.Assign (18, 2, 21, 3);
- Insert (New (Dialogs.PHistory, Init (R, Dialogs.PInputLine (Control), 13)));
- R.Assign (2, 5, 12, 7);
- Control := New (Dialogs.PButton, Init (R, slOK, cmOK, Dialogs.bfDefault));
- Control^.HelpCtx := hcDOk;
- Insert (Control);
- R.Assign (14, 5, 24, 7);
- Control := New (Dialogs.PButton, Init (R, slCancel, cmCancel, Dialogs.bfNormal));
- Control^.HelpCtx := hcDCancel;
- Insert (Control);
- SelectNext (False);
- end;
- RightMarginDialog := D;
- end; { RightMarginDialog; }
- function TabStopDialog : Dialogs.PDialog;
- { This is a local function that brings up a dialog box }
- { that allows the user to set their own tab stops. }
- VAR
- Index : Sw_Integer; { Local Indexing variable. }
- R : TRect;
- D : PDialog;
- Control : PView;
- Tab_Stop : String[2]; { Local string to print tab column number. }
- Begin
- R.Assign (0, 0, 80, 8);
- D := New (Dialogs.PDialog, Init (R, sTabSettings));
- with D^ do
- begin
- Options := Options or ofCentered;
- R.Assign (2, 2, 77, 3);
- Control := New (Dialogs.PStaticText, Init (R,
- ' ....|....|....|....|....|....|....|....|....|....|....|....|....|....|....'));
- Insert (Control);
- for Index := 1 to 7 do
- begin
- R.Assign (Index * 10 + 1, 1, Index * 10 + 3, 2);
- Str (Index * 10, Tab_Stop);
- Control := New (Dialogs.PStaticText, Init (R, Tab_Stop));
- Insert (Control);
- end;
- R.Assign (2, 3, 78, 4);
- Control := New (Dialogs.PInputLine, Init (R, 74));
- Control^.HelpCtx := hcDTabStops;
- Insert (Control);
- R.Assign (38, 5, 41, 6);
- Insert (New (Dialogs.PHistory, Init (R, Dialogs.PInputLine (Control), 14)));
- R.Assign (27, 5, 37, 7);
- Control := New (Dialogs.PButton, Init (R, slOK, cmOK, Dialogs.bfDefault));
- Control^.HelpCtx := hcDOk;
- Insert (Control);
- R.Assign (42, 5, 52, 7);
- Control := New (Dialogs.PButton, Init (R, slCancel, cmCancel, Dialogs.bfNormal));
- Control^.HelpCtx := hcDCancel;
- Insert (Control);
- SelectNext (False);
- end;
- TabStopDialog := D;
- end { TabStopDialog };
- function StdEditorDialog(Dialog: Integer; Info: Pointer): Word;
- var
- R: TRect;
- T: TPoint;
- begin
- case Dialog of
- edOutOfMemory:
- StdEditorDialog := MessageBox(sOutOfMemory, nil, mfError + mfOkButton);
- edReadError:
- StdEditorDialog := MessageBox(sFileReadError, @Info, mfError + mfOkButton);
- edWriteError:
- StdEditorDialog := MessageBox(sFileWriteError, @Info, mfError + mfOkButton);
- edCreateError:
- StdEditorDialog := MessageBox(sFileCreateError, @Info, mfError + mfOkButton);
- edSaveModify:
- StdEditorDialog := MessageBox(sModified, @Info, mfInformation + mfYesNoCancel);
- edSaveUntitled:
- StdEditorDialog := MessageBox(sFileUntitled, nil, mfInformation + mfYesNoCancel);
- edSaveAs:
- StdEditorDialog := Application^.ExecuteDialog(New(PFileDialog, Init('*.*',
- slSaveFileAs, slName, fdOkButton, 101)), Info);
- edFind:
- StdEditorDialog := Application^.ExecuteDialog(CreateFindDialog, Info);
- edSearchFailed:
- StdEditorDialog := MessageBox(sSearchStringNotFound, nil, mfError + mfOkButton);
- edReplace:
- StdEditorDialog := Application^.ExecuteDialog(CreateReplaceDialog, Info);
- edReplacePrompt:
- begin
- { Avoid placing the dialog on the same line as the cursor }
- R.Assign(0, 1, 40, 8);
- R.Move((Desktop^.Size.X - R.B.X) div 2, 0);
- Desktop^.MakeGlobal(R.B, T);
- Inc(T.Y);
- if PPoint(Info)^.Y <= T.Y then
- R.Move(0, Desktop^.Size.Y - R.B.Y - 2);
- StdEditorDialog := MessageBoxRect(R, sReplaceThisOccurence,
- nil, mfYesNoCancel + mfInformation);
- end;
- edJumpToLine:
- StdEditorDialog := Application^.ExecuteDialog(JumpLineDialog, Info);
- edSetTabStops:
- StdEditorDialog := Application^.ExecuteDialog(TabStopDialog, Info);
- edPasteNotPossible:
- StdEditorDialog := MessageBox (sPasteNotPossible, nil, mfError + mfOkButton);
- edReformatDocument:
- StdEditorDialog := Application^.ExecuteDialog(ReformDocDialog, Info);
- edReformatNotAllowed:
- StdEditorDialog := MessageBox (sWordWrapOff, nil, mfError + mfOkButton);
- edReformNotPossible:
- StdEditorDialog := MessageBox (sReformatNotPossible, nil, mfError + mfOkButton);
- edReplaceNotPossible:
- StdEditorDialog := MessageBox (sReplaceNotPossible, nil, mfError + mfOkButton);
- edRightMargin:
- StdEditorDialog := Application^.ExecuteDialog(RightMarginDialog, Info);
- edWrapNotPossible:
- StdEditorDialog := MessageBox (sWordWrapNotPossible, nil, mfError + mfOKButton);
- else
- StdEditorDialog := MessageBox (sUnknownDialog, nil, mfError + mfOkButton);
- end;
- end;
- {****************************************************************************
- Helpers
- ****************************************************************************}
- function CountLines(var Buf; Count: sw_Word): sw_Integer;
- var
- p : pchar;
- lines : sw_word;
- begin
- p:=pchar(@buf);
- lines:=0;
- while (count>0) do
- begin
- if p^ in [#10,#13] then
- begin
- inc(lines);
- if ord((p+1)^)+ord(p^)=23 then
- begin
- inc(p);
- dec(count);
- if count=0 then
- break;
- end;
- end;
- inc(p);
- dec(count);
- end;
- CountLines:=Lines;
- end;
- procedure GetLimits(var Buf; Count: sw_Word;var lim:objects.TPoint);
- { Get the limits needed for Buf, its an extended version of countlines (lim.y),
- which also gets the maximum line length in lim.x }
- var
- p : pchar;
- len : sw_word;
- begin
- lim.x:=0;
- lim.y:=0;
- len:=0;
- p:=pchar(@buf);
- while (count>0) do
- begin
- if p^ in [#10,#13] then
- begin
- if len>lim.x then
- lim.x:=len;
- inc(lim.y);
- if ord((p+1)^)+ord(p^)=23 then
- begin
- inc(p);
- dec(count);
- end;
- len:=0;
- end
- else
- inc(len);
- inc(p);
- dec(count);
- end;
- end;
- function ScanKeyMap(KeyMap: Pointer; KeyCode: Word): Word;
- var
- p : pword;
- count : sw_word;
- begin
- p:=keymap;
- count:=p^;
- inc(p);
- while (count>0) do
- begin
- if (lo(p^)=lo(keycode)) and
- ((hi(p^)=0) or (hi(p^)=hi(keycode))) then
- begin
- inc(p);
- scankeymap:=p^;
- exit;
- end;
- inc(p,2);
- dec(count);
- end;
- scankeymap:=0;
- end;
- Type
- Btable = Array[0..255] of Byte;
- Procedure BMMakeTable(const s:string; Var t : Btable);
- { Makes a Boyer-Moore search table. s = the search String t = the table }
- Var
- x : sw_integer;
- begin
- FillChar(t,sizeof(t),length(s));
- For x := length(s) downto 1 do
- if (t[ord(s[x])] = length(s)) then
- t[ord(s[x])] := length(s) - x;
- end;
- function Scan(var Block; Size: Sw_Word;const Str: String): Sw_Word;
- Var
- buffer : Array[0..MaxBufLength-1] of Byte Absolute block;
- s2 : String;
- len,
- numb : Sw_Word;
- found : Boolean;
- bt : Btable;
- begin
- BMMakeTable(str,bt);
- len:=length(str);
- s2[0]:=chr(len); { sets the length to that of the search String }
- found:=False;
- numb:=pred(len);
- While (not found) and (numb<(size-len)) do
- begin
- { partial match }
- if buffer[numb] = ord(str[len]) then
- begin
- { less partial! }
- if buffer[numb-pred(len)] = ord(str[1]) then
- begin
- move(buffer[numb-pred(len)],s2[1],len);
- if (str=s2) then
- begin
- found:=true;
- break;
- end;
- end;
- inc(numb);
- end
- else
- inc(numb,Bt[buffer[numb]]);
- end;
- if not found then
- Scan := NotFoundValue
- else
- Scan := numb - pred(len);
- end;
- function IScan(var Block; Size: Sw_Word;const Str: String): Sw_Word;
- Var
- buffer : Array[0..MaxBufLength-1] of Char Absolute block;
- s : String;
- len,
- numb,
- x : Sw_Word;
- found : Boolean;
- bt : Btable;
- p : pchar;
- c : char;
- begin
- len:=length(str);
- if (len=0) or (len>size) then
- begin
- IScan := NotFoundValue;
- exit;
- end;
- { create uppercased string }
- s[0]:=chr(len);
- for x:=1 to len do
- begin
- if str[x] in ['a'..'z'] then
- s[x]:=chr(ord(str[x])-32)
- else
- s[x]:=str[x];
- end;
- BMMakeTable(s,bt);
- found:=False;
- numb:=pred(len);
- While (not found) and (numb<(size-len)) do
- begin
- { partial match }
- c:=buffer[numb];
- if c in ['a'..'z'] then
- c:=chr(ord(c)-32);
- if (c=s[len]) then
- begin
- { less partial! }
- p:=@buffer[numb-pred(len)];
- x:=1;
- while (x<=len) do
- begin
- if not(((p^ in ['a'..'z']) and (chr(ord(p^)-32)=s[x])) or
- (p^=s[x])) then
- break;
- inc(p);
- inc(x);
- end;
- if (x>len) then
- begin
- found:=true;
- break;
- end;
- inc(numb);
- end
- else
- inc(numb,Bt[ord(c)]);
- end;
- if not found then
- IScan := NotFoundValue
- else
- IScan := numb - pred(len);
- end;
- {****************************************************************************
- TIndicator
- ****************************************************************************}
- constructor TIndicator.Init (var Bounds : TRect);
- begin
- Inherited Init (Bounds);
- GrowMode := gfGrowLoY + gfGrowHiY;
- end; { TIndicator.Init }
- procedure TIndicator.Draw;
- VAR
- Color : Byte;
- Frame : Char;
- L : array[0..1] of Longint;
- S : String[15];
- B : TDrawBuffer;
- begin
- if State and sfDragging = 0 then
- begin
- Color := GetColor (1);
- Frame := #205;
- end
- else
- begin
- Color := GetColor (2);
- Frame := #196;
- end;
- MoveChar (B, Frame, Color, Size.X);
- { If the text has been modified, put an 'M' in the TIndicator display. }
- if Modified then
- WordRec (B[1]).Lo := 77;
- { If WordWrap is active put a 'W' in the TIndicator display. }
- if WordWrap then
- WordRec (B[2]).Lo := 87
- else
- WordRec (B[2]).Lo := Byte (Frame);
- { If AutoIndent is active put an 'I' in TIndicator display. }
- if AutoIndent then
- WordRec (B[0]).Lo := 73
- else
- WordRec (B[0]).Lo := Byte (Frame);
- L[0] := Location.Y + 1;
- L[1] := Location.X + 1;
- FormatStr (S, ' %d:%d ', L);
- MoveStr (B[9 - Pos (':', S)], S, Color); { Changed original 8 to 9. }
- WriteBuf (0, 0, Size.X, 1, B);
- end; { TIndicator.Draw }
- function TIndicator.GetPalette : PPalette;
- const
- P : string[Length (CIndicator)] = CIndicator;
- begin
- GetPalette := PPalette(@P);
- end; { TIndicator.GetPalette }
- procedure TIndicator.SetState (AState : Word; Enable : Boolean);
- begin
- Inherited SetState (AState, Enable);
- if AState = sfDragging then
- DrawView;
- end; { TIndicator.SetState }
- procedure TIndicator.SetValue (ALocation : Objects.TPoint; IsAutoIndent : Boolean;
- IsModified : Boolean;
- IsWordWrap : Boolean);
- begin
- if (Location.X<>ALocation.X) or
- (Location.Y<>ALocation.Y) or
- (AutoIndent <> IsAutoIndent) or
- (Modified <> IsModified) or
- (WordWrap <> IsWordWrap) then
- begin
- Location := ALocation;
- AutoIndent := IsAutoIndent; { Added provisions to show AutoIndent. }
- Modified := IsModified;
- WordWrap := IsWordWrap; { Added provisions to show WordWrap. }
- DrawView;
- end;
- end; { TIndicator.SetValue }
- {****************************************************************************
- TLineInfo
- ****************************************************************************}
- constructor TLineInfo.Init;
- begin
- MaxPos:=0;
- Grow(1);
- end;
- destructor TLineInfo.Done;
- begin
- FreeMem(Info,MaxPos*sizeof(TLineInfoRec));
- Info := nil;
- end;
- procedure TLineInfo.Grow(pos:Sw_word);
- var
- NewSize : Sw_word;
- P : pointer;
- begin
- NewSize:=(Pos+LineInfoGrow-(Pos mod LineInfoGrow));
- GetMem(P,NewSize*sizeof(TLineInfoRec));
- FillChar(P^,NewSize*sizeof(TLineInfoRec),0);
- Move(Info^,P^,MaxPos*sizeof(TLineInfoRec));
- Freemem(Info,MaxPos*sizeof(TLineInfoRec));
- Info:=P;
- end;
- procedure TLineInfo.SetLen(pos,val:Sw_Word);
- begin
- if pos>=MaxPos then
- Grow(Pos);
- Info^[Pos].Len:=val
- end;
- procedure TLineInfo.SetAttr(pos,val:Sw_Word);
- begin
- if pos>=MaxPos then
- Grow(Pos);
- Info^[Pos].Attr:=val
- end;
- function TLineInfo.GetLen(pos:Sw_Word):Sw_Word;
- begin
- GetLen:=Info^[Pos].Len;
- end;
- function TLineInfo.GetAttr(pos:Sw_Word):Sw_Word;
- begin
- GetAttr:=Info^[Pos].Attr;
- end;
- {****************************************************************************
- TEditor
- ****************************************************************************}
- constructor TEditor.Init (var Bounds : TRect;
- AHScrollBar, AVScrollBar : PScrollBar;
- AIndicator : PIndicator; ABufSize : Sw_Word);
- var
- Element : Byte; { Place_Marker array element to initialize array with. }
- begin
- Inherited Init (Bounds);
- GrowMode := gfGrowHiX + gfGrowHiY;
- Options := Options or ofSelectable;
- Flags := EditorFlags;
- EventMask := evMouseDown + evKeyDown + evCommand + evBroadcast;
- ShowCursor;
- HScrollBar := AHScrollBar;
- VScrollBar := AVScrollBar;
- Indicator := AIndicator;
- BufSize := ABufSize;
- CanUndo := True;
- InitBuffer;
- if assigned(Buffer) then
- IsValid := True
- else
- begin
- EditorDialog (edOutOfMemory, nil);
- BufSize := 0;
- end;
- SetBufLen (0);
- for Element := 1 to 10 do
- Place_Marker[Element] := 0;
- Element := 1;
- while Element <= 70 do
- begin
- if Element mod 5 = 0 then
- Insert ('x', Tab_Settings, Element)
- else
- Insert (#32, Tab_Settings, Element);
- Inc (Element);
- end;
- { Default Right_Margin value. Change it if you want another. }
- Right_Margin := 76;
- TabSize:=8;
- end; { TEditor.Init }
- constructor TEditor.Load (var S : Objects.TStream);
- begin
- Inherited Load (S);
- GetPeerViewPtr (S, HScrollBar);
- GetPeerViewPtr (S, VScrollBar);
- GetPeerViewPtr (S, Indicator);
- S.Read (BufSize, SizeOf (BufSize));
- S.Read (CanUndo, SizeOf (CanUndo));
- S.Read (AutoIndent, SizeOf (AutoIndent));
- S.Read (Line_Number, SizeOf (Line_Number));
- S.Read (Place_Marker, SizeOf (Place_Marker));
- S.Read (Right_Margin, SizeOf (Right_Margin));
- S.Read (Tab_Settings, SizeOf (Tab_Settings));
- S.Read (Word_Wrap, SizeOf (Word_Wrap));
- InitBuffer;
- if Assigned(Buffer) then
- IsValid := True
- else
- begin
- EditorDialog (edOutOfMemory, nil);
- BufSize := 0;
- end;
- Lock;
- SetBufLen (0);
- end; { TEditor.Load }
- destructor TEditor.Done;
- begin
- DoneBuffer;
- Inherited Done;
- end; { TEditor.Done }
- function TEditor.BufChar(P: Sw_Word): Char;
- begin
- if P>=CurPtr then
- inc(P,Gaplen);
- BufChar:=Buffer^[P];
- end;
- function TEditor.BufPtr(P: Sw_Word): Sw_Word;
- begin
- if P>=CurPtr then
- BufPtr:=P+GapLen
- else
- BufPtr:=P;
- end;
- procedure TEditor.Center_Text (Select_Mode : Byte);
- { This procedure will center the current line of text. }
- { Centering is based on the current Right_Margin. }
- { If the Line_Length exceeds the Right_Margin, or the }
- { line is just a blank line, we exit and do nothing. }
- VAR
- Spaces : array [1..80] of Char; { Array to hold spaces we'll insert. }
- Index : Byte; { Index into Spaces array. }
- Line_Length : Sw_Integer; { Holds the length of the line. }
- E,S : Sw_Word; { End of the current line. }
- begin
- E := LineEnd (CurPtr);
- S := LineStart (CurPtr);
- { If the line is blank (only a CR/LF on it) then do noting. }
- if E = S then
- Exit;
- { Set CurPtr to start of line. Check if line begins with a space. }
- { We must strip out any spaces from the beginning, or end of lines. }
- { If line does not start with space, make sure line length does not }
- { exceed the Right_Margin. If it does, then do nothing. }
- SetCurPtr (S, Select_Mode);
- Remove_EOL_Spaces (Select_Mode);
- if Buffer^[CurPtr] = #32 then
- begin
- { If the next word is greater than the end of line then do nothing. }
- { If the line length is greater than Right_Margin then do nothing. }
- { Otherwise, delete all spaces at the start of line. }
- { Then reset end of line and put CurPtr at start of modified line. }
- E := LineEnd (CurPtr);
- if NextWord (CurPtr) > E then
- Exit;
- if E - NextWord (CurPtr) > Right_Margin then
- Exit;
- DeleteRange (CurPtr, NextWord (CurPtr), True);
- E := LineEnd (CurPtr);
- SetCurPtr (LineStart (CurPtr), Select_Mode);
- end
- else
- if E - CurPtr > Right_Margin then
- Exit;
- { Now we determine the real length of the line. }
- { Then we subtract the Line_Length from Right_Margin. }
- { Dividing the result by two tells us how many spaces }
- { must be inserted at start of line to center it. }
- { When we're all done, set the CurPtr to end of line. }
- Line_Length := E - CurPtr;
- for Index := 1 to ((Right_Margin - Line_Length) shr 1) do
- Spaces[Index] := #32;
- InsertText (@Spaces, Index, False);
- SetCurPtr (LineEnd (CurPtr), Select_Mode);
- end; { TEditor.Center_Text }
- procedure TEditor.ChangeBounds (var Bounds : TRect);
- begin
- SetBounds (Bounds);
- Delta.X := Max (0, Min (Delta.X, Limit.X - Size.X));
- Delta.Y := Max (0, Min (Delta.Y, Limit.Y - Size.Y));
- Update (ufView);
- end; { TEditor.ChangeBounds }
- function TEditor.CharPos (P, Target : Sw_Word) : Sw_Integer;
- VAR
- Pos : Sw_Integer;
- begin
- Pos := 0;
- while P < Target do
- begin
- if BufChar (P) = #9 then
- Pos := Pos or 7;
- Inc (Pos);
- Inc (P);
- end;
- CharPos := Pos;
- end; { TEditor.CharPos }
- function TEditor.CharPtr (P : Sw_Word; Target : Sw_Integer) : Sw_Word;
- VAR
- Pos : Sw_Integer;
- begin
- Pos := 0;
- while (Pos < Target) and (P < BufLen) and not(BufChar (P) in [#10,#13]) do
- begin
- if BufChar (P) = #9 then
- Pos := Pos or 7;
- Inc (Pos);
- Inc (P);
- end;
- if Pos > Target then
- Dec (P);
- CharPtr := P;
- end; { TEditor.CharPtr }
- procedure TEditor.Check_For_Word_Wrap (Select_Mode : Byte;
- Center_Cursor : Boolean);
- { This procedure checks if CurPos.X > Right_Margin. }
- { If it is, then we Do_Word_Wrap. Simple, eh? }
- begin
- if CurPos.X > Right_Margin then
- Do_Word_Wrap (Select_Mode, Center_Cursor);
- end; {Check_For_Word_Wrap}
- function TEditor.ClipCopy : Boolean;
- begin
- ClipCopy := False;
- if Assigned(Clipboard) and (Clipboard <> @Self) then
- begin
- ClipCopy := Clipboard^.InsertFrom (@Self);
- Selecting := False;
- Update (ufUpdate);
- end;
- end; { TEditor.ClipCopy }
- procedure TEditor.ClipCut;
- begin
- if ClipCopy then
- begin
- Update_Place_Markers (0,
- Self.SelEnd - Self.SelStart,
- Self.SelStart,
- Self.SelEnd);
- DeleteSelect;
- end;
- end; { TEditor.ClipCut }
- procedure TEditor.ClipPaste;
- begin
- if Assigned(Clipboard) and (Clipboard <> @Self) then
- begin
- { Do not allow paste operations that will exceed }
- { the Right_Margin when Word_Wrap is active and }
- { cursor is at EOL. }
- if Word_Wrap and (CurPos.X > Right_Margin) then
- begin
- EditorDialog (edPasteNotPossible, nil);
- Exit;
- end;
- { The editor will not copy selected text if the CurPtr }
- { is not the same value as the SelStart. However, it }
- { does return an InsCount. This may, or may not, be a }
- { bug. We don't want to update the Place_Marker if }
- { there's no text copied. }
- if CurPtr = SelStart then
- Update_Place_Markers (Clipboard^.SelEnd - Clipboard^.SelStart,
- 0,
- Clipboard^.SelStart,
- Clipboard^.SelEnd);
- InsertFrom (Clipboard);
- end;
- end; { TEditor.ClipPaste }
- procedure TEditor.ConvertEvent (var Event : Drivers.TEvent);
- VAR
- ShiftState : Byte;
- Key : Word;
- begin
- ShiftState:=GetShiftState;
- if Event.What = evKeyDown then
- begin
- if (ShiftState and $03 <> 0)
- and (Event.ScanCode >= $47)
- and (Event.ScanCode <= $51) then
- Event.CharCode := #0;
- Key := Event.KeyCode;
- if KeyState <> 0 then
- begin
- if (Lo (Key) >= $01) and (Lo (Key) <= $1A) then
- Inc (Key, $40);
- if (Lo (Key) >= $61) and (Lo (Key) <= $7A) then
- Dec (Key, $20);
- end;
- Key := ScanKeyMap (KeyMap[KeyState], Key);
- KeyState := 0;
- if Key <> 0 then
- if Hi (Key) = $FF then
- begin
- KeyState := Lo (Key);
- ClearEvent (Event);
- end
- else
- begin
- Event.What := evCommand;
- Event.Command := Key;
- end;
- end;
- end; { TEditor.ConvertEvent }
- function TEditor.CursorVisible : Boolean;
- begin
- CursorVisible := (CurPos.Y >= Delta.Y) and (CurPos.Y < Delta.Y + Size.Y);
- end; { TEditor.CursorVisible }
- procedure TEditor.DeleteRange (StartPtr, EndPtr : Sw_Word; DelSelect : Boolean);
- begin
- { This will update Place_Marker for all deletions. }
- { EXCEPT the Remove_EOL_Spaces deletion. }
- Update_Place_Markers (0, EndPtr - StartPtr, StartPtr, EndPtr);
- if HasSelection and DelSelect then
- DeleteSelect
- else
- begin
- SetSelect (CurPtr, EndPtr, True);
- DeleteSelect;
- SetSelect (StartPtr, CurPtr, False);
- DeleteSelect;
- end;
- end; { TEditor.DeleteRange }
- procedure TEditor.DeleteSelect;
- begin
- InsertText (nil, 0, False);
- end; { TEditor.DeleteSelect }
- procedure TEditor.DoneBuffer;
- begin
- ReAllocMem(Buffer, 0);
- end; { TEditor.DoneBuffer }
- procedure TEditor.DoSearchReplace;
- VAR
- I : Sw_Word;
- C : Objects.TPoint;
- begin
- repeat
- I := cmCancel;
- if not Search (FindStr, Flags) then
- begin
- if Flags and (efReplaceAll + efDoReplace) <> (efReplaceAll + efDoReplace) then
- EditorDialog (edSearchFailed, nil)
- end
- else
- if Flags and efDoReplace <> 0 then
- begin
- I := cmYes;
- if Flags and efPromptOnReplace <> 0 then
- begin
- MakeGlobal (Cursor, C);
- I := EditorDialog (edReplacePrompt, Pointer(@C));
- end;
- if I = cmYes then
- begin
- { If Word_Wrap is active and we are at EOL }
- { disallow replace by bringing up a dialog }
- { stating that replace is not possible. }
- if Word_Wrap and
- ((CurPos.X + (Length (ReplaceStr) - Length (FindStr))) > Right_Margin) then
- EditorDialog (edReplaceNotPossible, nil)
- else
- begin
- Lock;
- Search_Replace := True;
- if length (ReplaceStr) < length (FindStr) then
- Update_Place_Markers (0,
- Length (FindStr) - Length (ReplaceStr),
- CurPtr - Length (FindStr) + Length (ReplaceStr),
- CurPtr)
- else
- if length (ReplaceStr) > length (FindStr) then
- Update_Place_Markers (Length (ReplaceStr) - Length (FindStr),
- 0,
- CurPtr,
- CurPtr + (Length (ReplaceStr) - Length (FindStr)));
- InsertText (@ReplaceStr[1], Length (ReplaceStr), False);
- Search_Replace := False;
- TrackCursor (False);
- Unlock;
- end;
- end;
- end;
- until (I = cmCancel) or (Flags and efReplaceAll = 0);
- end; { TEditor.DoSearchReplace }
- procedure TEditor.DoUpdate;
- begin
- if UpdateFlags <> 0 then
- begin
- SetCursor (CurPos.X - Delta.X, CurPos.Y - Delta.Y);
- if UpdateFlags and ufView <> 0 then
- DrawView
- else
- if UpdateFlags and ufLine <> 0 then
- DrawLines (CurPos.Y - Delta.Y, 1, LineStart (CurPtr));
- if assigned(HScrollBar) then
- HScrollBar^.SetParams (Delta.X, 0, Limit.X - Size.X, Size.X div 2, 1);
- if assigned(VScrollBar) then
- VScrollBar^.SetParams (Delta.Y, 0, Limit.Y - Size.Y, Size.Y - 1, 1);
- if assigned(Indicator) then
- Indicator^.SetValue (CurPos, AutoIndent, Modified, Word_Wrap);
- if State and sfActive <> 0 then
- UpdateCommands;
- UpdateFlags := 0;
- end;
- end; { TEditor.DoUpdate }
- function TEditor.Do_Word_Wrap (Select_Mode : Byte;
- Center_Cursor : Boolean) : Boolean;
- { This procedure does the actual wordwrap. It always assumes the CurPtr }
- { is at Right_Margin + 1. It makes several tests for special conditions }
- { and processes those first. If they all fail, it does a normal wrap. }
- VAR
- A : Sw_Word; { Distance between line start and first word on line. }
- C : Sw_Word; { Current pointer when we come into procedure. }
- L : Sw_Word; { BufLen when we come into procedure. }
- P : Sw_Word; { Position of pointer at any given moment. }
- S : Sw_Word; { Start of a line. }
- begin
- Do_Word_Wrap := False;
- Select_Mode := 0;
- if BufLen >= (BufSize - 1) then
- exit;
- C := CurPtr;
- L := BufLen;
- S := LineStart (CurPtr);
- { If first character in the line is a space and autoindent mode is on }
- { then we check to see if NextWord(S) exceeds the CurPtr. If it does, }
- { we set CurPtr as the AutoIndent marker. If it doesn't, we will set }
- { NextWord(S) as the AutoIndent marker. If neither, we set it to S. }
- if AutoIndent and (Buffer^[S] = ' ') then
- begin
- if NextWord (S) > CurPtr then
- A := CurPtr
- else
- A := NextWord (S);
- end
- else
- A := NextWord (S);
- { Though NewLine will remove EOL spaces, we do it here too. }
- { This catches the instance where a user may try to space }
- { completely across the line, in which case CurPtr.X = 0. }
- Remove_EOL_Spaces (Select_Mode);
- if CurPos.X = 0 then
- begin
- NewLine (Select_Mode);
- Do_Word_Wrap := True;
- Exit;
- end;
- { At this point we have one of five situations: }
- { }
- { 1) AutoIndent is on and this line is all spaces before CurPtr. }
- { 2) AutoIndent is off and this line is all spaces before CurPtr. }
- { 3) AutoIndent is on and this line is continuous characters before CurPtr. }
- { 4) AutoIndent is off and this line is continuous characters before CurPtr. }
- { 5) This is just a normal line of text. }
- { }
- { Conditions 1 through 4 have to be taken into account before condition 5. }
- { First, we see if there are all spaces and/or all characters. }
- { Then we determine which one it really is. Finally, we take }
- { a course of action based on the state of AutoIndent. }
- if PrevWord (CurPtr) <= S then
- begin
- P := CurPtr - 1;
- while ((Buffer^[P] <> ' ') and (P > S)) do
- Dec (P);
- { We found NO SPACES. Conditions 4 and 5 are treated the same. }
- { We can NOT do word wrap and put up a dialog box stating such. }
- { Delete character just entered so we don't exceed Right_Margin. }
- if P = S then
- begin
- EditorDialog (edWrapNotPossible, nil);
- DeleteRange (PrevChar (CurPtr), CurPtr, True);
- Exit;
- end
- else
- begin
- { There are spaces. Now find out if they are all spaces. }
- { If so, see if AutoIndent is on. If it is, turn it off, }
- { do a NewLine, and turn it back on. Otherwise, just do }
- { the NewLine. We go through all of these gyrations for }
- { AutoIndent. Being way out here with a preceding line }
- { of spaces and wrapping with AutoIndent on is real dumb! }
- { However, the user expects something. The wrap will NOT }
- { autoindent, but they had no business being here anyway! }
- P := CurPtr - 1;
- while ((Buffer^[P] = ' ') and (P > S)) do
- Dec (P);
- if P = S then
- begin
- if Autoindent then
- begin
- AutoIndent := False;
- NewLine (Select_Mode);
- AutoIndent := True;
- end
- else
- NewLine (Select_Mode);
- end; { AutoIndent }
- end; { P = S for spaces }
- end { P = S for no spaces }
- else { PrevWord (CurPtr) <= S }
- begin
- { Hooray! We actually had a plain old line of text to wrap! }
- { Regardless if we are pushing out a line beyond the Right_Margin, }
- { or at the end of a line itself, the following will determine }
- { exactly where to do the wrap and re-set the cursor accordingly. }
- { However, if P = A then we can't wrap. Show dialog and exit. }
- P := CurPtr;
- while P - S > Right_Margin do
- P := PrevWord (P);
- if (P = A) then
- begin
- EditorDialog (edReformNotPossible, nil);
- SetCurPtr (P, Select_Mode);
- Exit;
- end;
- SetCurPtr (P, Select_Mode);
- NewLine (Select_Mode);
- end; { PrevWord (CurPtr <= S }
- { Track the cursor here (it is at CurPos.X = 0) so the view }
- { will redraw itself at column 0. This eliminates having it }
- { redraw starting at the current cursor and not being able }
- { to see text before the cursor. Of course, we also end up }
- { redrawing the view twice, here and back in HandleEvent. }
- { }
- { Reposition cursor so user can pick up where they left off. }
- TrackCursor (Center_Cursor);
- SetCurPtr (C - (L - BufLen), Select_Mode);
- Do_Word_Wrap := True;
- end; { TEditor.Do_Word_Wrap }
- procedure TEditor.Draw;
- begin
- if DrawLine <> Delta.Y then
- begin
- DrawPtr := LineMove (DrawPtr, Delta.Y - DrawLine);
- DrawLine := Delta.Y;
- end;
- DrawLines (0, Size.Y, DrawPtr);
- end; { TEditor.Draw }
- procedure TEditor.DrawLines (Y, Count : Sw_Integer; LinePtr : Sw_Word);
- VAR
- Color : Word;
- B : array[0..MaxLineLength - 1] of Sw_Word;
- begin
- Color := GetColor ($0201);
- while Count > 0 do
- begin
- FormatLine (B, LinePtr, Delta.X + Size.X, Color);
- WriteBuf (0, Y, Size.X, 1, B[Delta.X]);
- LinePtr := NextLine (LinePtr);
- Inc (Y);
- Dec (Count);
- end;
- end; { TEditor.DrawLines }
- procedure TEditor.Find;
- VAR
- FindRec : TFindDialogRec;
- begin
- with FindRec do
- begin
- Find := FindStr;
- Options := Flags;
- if EditorDialog (edFind, @FindRec) <> cmCancel then
- begin
- FindStr := Find;
- Flags := Options and not efDoReplace;
- DoSearchReplace;
- end;
- end;
- end; { TEditor.Find }
- procedure TEditor.FormatLine (var DrawBuf; LinePtr : Sw_Word;
- Width : Sw_Integer;
- Colors : Word);
- var
- outptr : pword;
- outcnt,
- idxpos : Sw_Word;
- attr : Word;
- procedure FillSpace(i:Sw_Word);
- var
- w : word;
- begin
- inc(OutCnt,i);
- w:=32 or attr;
- while (i>0) do
- begin
- OutPtr^:=w;
- inc(OutPtr);
- dec(i);
- end;
- end;
- function FormatUntil(endpos:Sw_word):boolean;
- var
- p : pchar;
- begin
- FormatUntil:=false;
- p:=pchar(Buffer)+idxpos;
- while endpos>idxpos do
- begin
- if OutCnt>=Width then
- exit;
- case p^ of
- #9 :
- FillSpace(Tabsize-(outcnt mod Tabsize));
- #10,#13 :
- begin
- FillSpace(Width-OutCnt);
- FormatUntil:=true;
- exit;
- end;
- else
- begin
- inc(OutCnt);
- OutPtr^:=ord(p^) or attr;
- inc(OutPtr);
- end;
- end; { case }
- inc(p);
- inc(idxpos);
- end;
- end;
- begin
- OutCnt:=0;
- OutPtr:=@DrawBuf;
- idxPos:=LinePtr;
- attr:=lo(Colors) shl 8;
- if FormatUntil(SelStart) then
- exit;
- attr:=hi(Colors) shl 8;
- if FormatUntil(CurPtr) then
- exit;
- inc(idxPos,GapLen);
- if FormatUntil(SelEnd+GapLen) then
- exit;
- attr:=lo(Colors) shl 8;
- if FormatUntil(BufSize) then
- exit;
- { fill up until width }
- FillSpace(Width-OutCnt);
- end; {TEditor.FormatLine}
- function TEditor.GetMousePtr (Mouse : Objects.TPoint) : Sw_Word;
- begin
- MakeLocal (Mouse, Mouse);
- Mouse.X := Max (0, Min (Mouse.X, Size.X - 1));
- Mouse.Y := Max (0, Min (Mouse.Y, Size.Y - 1));
- GetMousePtr := CharPtr (LineMove (DrawPtr, Mouse.Y + Delta.Y - DrawLine),
- Mouse.X + Delta.X);
- end; { TEditor.GetMousePtr }
- function TEditor.GetPalette : PPalette;
- CONST
- P : String[Length (CEditor)] = CEditor;
- begin
- GetPalette := PPalette(@P);
- end; { TEditor.GetPalette }
- procedure TEditor.HandleEvent (var Event : Drivers.TEvent);
- VAR
- ShiftState : Byte;
- CenterCursor : Boolean;
- SelectMode : Byte;
- D : Objects.TPoint;
- Mouse : Objects.TPoint;
- function CheckScrollBar (P : PScrollBar; var D : Sw_Integer) : Boolean;
- begin
- CheckScrollBar := FALSE;
- if (Event.InfoPtr = P) and (P^.Value <> D) then
- begin
- D := P^.Value;
- Update (ufView);
- CheckScrollBar := TRUE;
- end;
- end; {CheckScrollBar}
- begin
- Inherited HandleEvent (Event);
- ConvertEvent (Event);
- CenterCursor := not CursorVisible;
- SelectMode := 0;
- ShiftState:=GetShiftState;
- if Selecting or (ShiftState and $03 <> 0) then
- SelectMode := smExtend;
- case Event.What of
- Drivers.evMouseDown:
- begin
- if Event.Double then
- SelectMode := SelectMode or smDouble;
- repeat
- Lock;
- if Event.What = evMouseAuto then
- begin
- MakeLocal (Event.Where, Mouse);
- D := Delta;
- if Mouse.X < 0 then
- Dec (D.X);
- if Mouse.X >= Size.X then
- Inc (D.X);
- if Mouse.Y < 0 then
- Dec (D.Y);
- if Mouse.Y >= Size.Y then
- Inc (D.Y);
- ScrollTo (D.X, D.Y);
- end;
- SetCurPtr (GetMousePtr (Event.Where), SelectMode);
- SelectMode := SelectMode or smExtend;
- Unlock;
- until not MouseEvent (Event, evMouseMove + evMouseAuto);
- end; { Drivers.evMouseDown }
- Drivers.evKeyDown:
- case Event.CharCode of
- #32..#255:
- begin
- Lock;
- if Overwrite and not HasSelection then
- if CurPtr <> LineEnd (CurPtr) then
- SelEnd := NextChar (CurPtr);
- InsertText (@Event.CharCode, 1, False);
- if Word_Wrap then
- Check_For_Word_Wrap (SelectMode, CenterCursor);
- TrackCursor (CenterCursor);
- Unlock;
- end;
- else
- Exit;
- end; { Drivers.evKeyDown }
- Drivers.evCommand:
- case Event.Command of
- cmFind : Find;
- cmReplace : Replace;
- cmSearchAgain : DoSearchReplace;
- else
- begin
- Lock;
- case Event.Command of
- cmCut : ClipCut;
- cmCopy : ClipCopy;
- cmPaste : ClipPaste;
- cmUndo : Undo;
- cmClear : DeleteSelect;
- cmCharLeft : SetCurPtr (PrevChar (CurPtr), SelectMode);
- cmCharRight : SetCurPtr (NextChar (CurPtr), SelectMode);
- cmWordLeft : SetCurPtr (PrevWord (CurPtr), SelectMode);
- cmWordRight : SetCurPtr (NextWord (CurPtr), SelectMode);
- cmLineStart : SetCurPtr (LineStart (CurPtr), SelectMode);
- cmLineEnd : SetCurPtr (LineEnd (CurPtr), SelectMode);
- cmLineUp : SetCurPtr (LineMove (CurPtr, -1), SelectMode);
- cmLineDown : SetCurPtr (LineMove (CurPtr, 1), SelectMode);
- cmPageUp : SetCurPtr (LineMove (CurPtr, - (Size.Y - 1)), SelectMode);
- cmPageDown : SetCurPtr (LineMove (CurPtr, Size.Y - 1), SelectMode);
- cmTextStart : SetCurPtr (0, SelectMode);
- cmTextEnd : SetCurPtr (BufLen, SelectMode);
- cmNewLine : NewLine (SelectMode);
- cmBackSpace : DeleteRange (PrevChar (CurPtr), CurPtr, True);
- cmDelChar : DeleteRange (CurPtr, NextChar (CurPtr), True);
- cmDelWord : DeleteRange (CurPtr, NextWord (CurPtr), False);
- cmDelStart : DeleteRange (LineStart (CurPtr), CurPtr, False);
- cmDelEnd : DeleteRange (CurPtr, LineEnd (CurPtr), False);
- cmDelLine : DeleteRange (LineStart (CurPtr), NextLine (CurPtr), False);
- cmInsMode : ToggleInsMode;
- cmStartSelect : StartSelect;
- cmHideSelect : HideSelect;
- cmIndentMode : begin
- AutoIndent := not AutoIndent;
- Update (ufStats);
- end; { Added provision to update TIndicator if ^QI pressed. }
- cmCenterText : Center_Text (SelectMode);
- cmEndPage : SetCurPtr (LineMove (CurPtr, Delta.Y - CurPos.Y + Size.Y - 1), SelectMode);
- cmHomePage : SetCurPtr (LineMove (CurPtr, -(CurPos.Y - Delta.Y)), SelectMode);
- cmInsertLine : Insert_Line (SelectMode);
- cmJumpLine : Jump_To_Line (SelectMode);
- cmReformDoc : Reformat_Document (SelectMode, CenterCursor);
- cmReformPara : Reformat_Paragraph (SelectMode, CenterCursor);
- cmRightMargin : Set_Right_Margin;
- cmScrollDown : Scroll_Down;
- cmScrollUp : Scroll_Up;
- cmSelectWord : Select_Word;
- cmSetTabs : Set_Tabs;
- cmTabKey : Tab_Key (SelectMode);
- cmWordWrap : begin
- Word_Wrap := not Word_Wrap;
- Update (ufStats);
- end; { Added provision to update TIndicator if ^OW pressed. }
- cmSetMark0 : Set_Place_Marker (10);
- cmSetMark1 : Set_Place_Marker (1);
- cmSetMark2 : Set_Place_Marker (2);
- cmSetMark3 : Set_Place_Marker (3);
- cmSetMark4 : Set_Place_Marker (4);
- cmSetMark5 : Set_Place_Marker (5);
- cmSetMark6 : Set_Place_Marker (6);
- cmSetMark7 : Set_Place_Marker (7);
- cmSetMark8 : Set_Place_Marker (8);
- cmSetMark9 : Set_Place_Marker (9);
- cmJumpMark0 : Jump_Place_Marker (10, SelectMode);
- cmJumpMark1 : Jump_Place_Marker (1, SelectMode);
- cmJumpMark2 : Jump_Place_Marker (2, SelectMode);
- cmJumpMark3 : Jump_Place_Marker (3, SelectMode);
- cmJumpMark4 : Jump_Place_Marker (4, SelectMode);
- cmJumpMark5 : Jump_Place_Marker (5, SelectMode);
- cmJumpMark6 : Jump_Place_Marker (6, SelectMode);
- cmJumpMark7 : Jump_Place_Marker (7, SelectMode);
- cmJumpMark8 : Jump_Place_Marker (8, SelectMode);
- cmJumpMark9 : Jump_Place_Marker (9, SelectMode);
- else
- Unlock;
- Exit;
- end; { Event.Command (Inner) }
- TrackCursor (CenterCursor);
- { If the user presses any key except cmNewline or cmBackspace }
- { we need to check if the file has been modified yet. There }
- { can be no spaces at the end of a line, or wordwrap doesn't }
- { work properly. We don't want to do this if the file hasn't }
- { been modified because the user could be bringing in an ASCII }
- { file from an editor that allows spaces at the EOL. If we }
- { took them out in that scenario the "M" would appear on the }
- { TIndicator line and the user would get upset or confused. }
- if (Event.Command <> cmNewLine) and
- (Event.Command <> cmBackSpace) and
- (Event.Command <> cmTabKey) and
- Modified then
- Remove_EOL_Spaces (SelectMode);
- Unlock;
- end; { Event.Command (Outer) }
- end; { Drivers.evCommand }
- Drivers.evBroadcast:
- case Event.Command of
- cmScrollBarChanged:
- if (Event.InfoPtr = HScrollBar) or
- (Event.InfoPtr = VScrollBar) then
- begin
- CheckScrollBar (HScrollBar, Delta.X);
- CheckScrollBar (VScrollBar, Delta.Y);
- end
- else
- exit;
- else
- Exit;
- end; { Drivers.evBroadcast }
- end;
- ClearEvent (Event);
- end; { TEditor.HandleEvent }
- function TEditor.HasSelection : Boolean;
- begin
- HasSelection := SelStart <> SelEnd;
- end; { TEditor.HasSelection }
- procedure TEditor.HideSelect;
- begin
- Selecting := False;
- SetSelect (CurPtr, CurPtr, False);
- end; { TEditor.HideSelect }
- procedure TEditor.InitBuffer;
- begin
- Assert(Buffer = nil, 'TEditor.InitBuffer: Buffer is not nil');
- ReAllocMem(Buffer, BufSize);
- end; { TEditor.InitBuffer }
- function TEditor.InsertBuffer (var P : PEditBuffer;
- Offset, Length : Sw_Word;
- AllowUndo, SelectText : Boolean) : Boolean;
- VAR
- SelLen : Sw_Word;
- DelLen : Sw_Word;
- SelLines : Sw_Word;
- Lines : Sw_Word;
- NewSize : Longint;
- begin
- InsertBuffer := True;
- Selecting := False;
- SelLen := SelEnd - SelStart;
- if (SelLen = 0) and (Length = 0) then
- Exit;
- DelLen := 0;
- if AllowUndo then
- if CurPtr = SelStart then
- DelLen := SelLen
- else
- if SelLen > InsCount then
- DelLen := SelLen - InsCount;
- NewSize := Longint (BufLen + DelCount - SelLen + DelLen) + Length;
- if NewSize > BufLen + DelCount then
- if (NewSize > MaxBufLength) or not SetBufSize (NewSize) then
- begin
- EditorDialog (edOutOfMemory, nil);
- InsertBuffer := False;
- SelEnd := SelStart;
- Exit;
- end;
- SelLines := CountLines (Buffer^[BufPtr (SelStart)], SelLen);
- if CurPtr = SelEnd then
- begin
- if AllowUndo then
- begin
- if DelLen > 0 then
- Move (Buffer^[SelStart], Buffer^[CurPtr + GapLen - DelCount - DelLen], DelLen);
- Dec (InsCount, SelLen - DelLen);
- end;
- CurPtr := SelStart;
- Dec (CurPos.Y, SelLines);
- end;
- if Delta.Y > CurPos.Y then
- begin
- Dec (Delta.Y, SelLines);
- if Delta.Y < CurPos.Y then
- Delta.Y := CurPos.Y;
- end;
- if Length > 0 then
- Move (P^[Offset], Buffer^[CurPtr], Length);
- Lines := CountLines (Buffer^[CurPtr], Length);
- Inc (CurPtr, Length);
- Inc (CurPos.Y, Lines);
- DrawLine := CurPos.Y;
- DrawPtr := LineStart (CurPtr);
- CurPos.X := CharPos (DrawPtr, CurPtr);
- if not SelectText then
- SelStart := CurPtr;
- SelEnd := CurPtr;
- if Length>Sellen then
- begin
- Inc (BufLen, Length - SelLen);
- Dec (GapLen, Length - SelLen);
- end
- else
- begin
- Dec (BufLen, Sellen - Length);
- Inc (GapLen, Sellen - Length);
- end;
- if AllowUndo then
- begin
- Inc (DelCount, DelLen);
- Inc (InsCount, Length);
- end;
- Inc (Limit.Y, Lines - SelLines);
- Delta.Y := Max (0, Min (Delta.Y, Limit.Y - Size.Y));
- if not IsClipboard then
- Modified := True;
- SetBufSize (BufLen + DelCount);
- if (SelLines = 0) and (Lines = 0) then
- Update (ufLine)
- else
- Update (ufView);
- end; { TEditor.InsertBuffer }
- function TEditor.InsertFrom (Editor : PEditor) : Boolean;
- begin
- InsertFrom := InsertBuffer (Editor^.Buffer,
- Editor^.BufPtr (Editor^.SelStart),
- Editor^.SelEnd - Editor^.SelStart, CanUndo, IsClipboard);
- end; { TEditor.InsertFrom }
- procedure TEditor.Insert_Line (Select_Mode : Byte);
- { This procedure inserts a newline at the current cursor position }
- { if a ^N is pressed. Unlike cmNewLine, the cursor will return }
- { to its original position. If the cursor was at the end of a }
- { line, and its spaces were removed, the cursor returns to the }
- { end of the line instead. }
- begin
- NewLine (Select_Mode);
- SetCurPtr (LineEnd (LineMove (CurPtr, -1)), Select_Mode);
- end; { TEditor.Insert_Line }
- function TEditor.InsertText (Text : Pointer;
- Length : Sw_Word;
- SelectText : Boolean) : Boolean;
- begin
- if assigned(Text) and not Search_Replace then
- Update_Place_Markers (Length, 0, Self.SelStart, Self.SelEnd);
- InsertText := InsertBuffer (PEditBuffer (Text),
- 0, Length, CanUndo, SelectText);
- end; { TEditor.InsertText }
- function TEditor.IsClipboard : Boolean;
- begin
- IsClipboard := Clipboard = @Self;
- end; { TEditor.IsClipboard }
- procedure TEditor.Jump_Place_Marker (Element : Byte; Select_Mode : Byte);
- { This procedure jumps to a place marker if ^Q# is pressed. }
- { We don't go anywhere if Place_Marker[Element] is not zero. }
- begin
- if (not IsClipboard) and (Place_Marker[Element] <> 0) then
- SetCurPtr (Place_Marker[Element], Select_Mode);
- end; { TEditor.Jump_Place_Marker }
- procedure TEditor.Jump_To_Line (Select_Mode : Byte);
- { This function brings up a dialog box that allows }
- { the user to select a line number to jump to. }
- VAR
- Code : Integer; { Used for Val conversion. }
- Temp_Value : Longint; { Holds converted dialog value. }
- begin
- if EditorDialog (edJumpToLine, @Line_Number) <> cmCancel then
- begin
- { Convert the Line_Number string to an interger. }
- { Put it into Temp_Value. If the number is not }
- { in the range 1..9999 abort. If the number is }
- { our current Y position, abort. Otherwise, }
- { go to top of document, and jump to the line. }
- { There are faster methods. This one's easy. }
- { Note that CurPos.Y is always 1 less than what }
- { the TIndicator line says. }
- val (Line_Number, Temp_Value, Code);
- if (Temp_Value < 1) or (Temp_Value > 9999999) then
- Exit;
- if Temp_Value = CurPos.Y + 1 then
- Exit;
- SetCurPtr (0, Select_Mode);
- SetCurPtr (LineMove (CurPtr, Temp_Value - 1), Select_Mode);
- end;
- end; {TEditor.Jump_To_Line}
- function TEditor.LineEnd (P : Sw_Word) : Sw_Word;
- var
- start,
- i : Sw_word;
- pc : pchar;
- begin
- if P<CurPtr then
- begin
- i:=CurPtr-P;
- pc:=pchar(Buffer)+P;
- while (i>0) do
- begin
- if pc^ in [#10,#13] then
- begin
- LineEnd:=pc-pchar(Buffer);
- exit;
- end;
- inc(pc);
- dec(i);
- end;
- start:=CurPtr;
- end
- else
- start:=P;
- i:=BufLen-Start;
- pc:=pchar(Buffer)+GapLen+start;
- while (i>0) do
- begin
- if pc^ in [#10,#13] then
- begin
- LineEnd:=pc-(pchar(Buffer)+Gaplen);
- exit;
- end;
- inc(pc);
- dec(i);
- end;
- LineEnd:=pc-(pchar(Buffer)+Gaplen);
- end; { TEditor.LineEnd }
- function TEditor.LineMove (P : Sw_Word; Count : Sw_Integer) : Sw_Word;
- VAR
- Pos : Sw_Integer;
- I : Sw_Word;
- begin
- I := P;
- P := LineStart (P);
- Pos := CharPos (P, I);
- while Count <> 0 do
- begin
- I := P;
- if Count < 0 then
- begin
- P := PrevLine (P);
- Inc (Count);
- end
- else
- begin
- P := NextLine (P);
- Dec (Count);
- end;
- end;
- if P <> I then
- P := CharPtr (P, Pos);
- LineMove := P;
- end; { TEditor.LineMove }
- function TEditor.LineStart (P : Sw_Word) : Sw_Word;
- var
- i : Sw_word;
- start,pc : pchar;
- oc : char;
- begin
- if P>CurPtr then
- begin
- start:=pchar(Buffer)+GapLen;
- pc:=start;
- i:=P-CurPtr;
- dec(pc);
- while (i>0) do
- begin
- if pc^ in [#10,#13] then
- break;
- dec(pc);
- dec(i);
- end;
- end
- else
- i:=0;
- if i=0 then
- begin
- start:=pchar(Buffer);
- i:=P;
- pc:=start+p;
- dec(pc);
- while (i>0) do
- begin
- if pc^ in [#10,#13] then
- break;
- dec(pc);
- dec(i);
- end;
- if i=0 then
- begin
- LineStart:=0;
- exit;
- end;
- end;
- oc:=pc^;
- LineStart:=pc-start+1;
- end; { TEditor.LineStart }
- function TEditor.LineNr (P : Sw_Word) : Sw_Word;
- var
- pc,endp : pchar;
- lines : sw_word;
- begin
- endp:=pchar(Buffer)+BufPtr(P);
- pc:=pchar(Buffer);
- lines:=0;
- while (pc<endp) do
- begin
- if pc^ in [#10,#13] then
- begin
- inc(lines);
- if ord((pc+1)^)+ord(pc^)=23 then
- begin
- inc(pc);
- if (pc>=endp) then
- break;
- end;
- end;
- inc(pc);
- end;
- LineNr:=Lines;
- end;
- procedure TEditor.Lock;
- begin
- Inc (LockCount);
- end; { TEditor.Lock }
- function TEditor.NewLine (Select_Mode : Byte) : Boolean;
- VAR
- I : Sw_Word; { Used to track spaces for AutoIndent. }
- P : Sw_Word; { Position of Cursor when we arrive and after Newline. }
- begin
- P := LineStart (CurPtr);
- I := P;
- { The first thing we do is remove any End Of Line spaces. }
- { Then we check to see how many spaces are on beginning }
- { of a line. We need this check to add them after CR/LF }
- { if AutoIndenting. Last of all we insert spaces required }
- { for the AutoIndenting, if it was on. }
- Remove_EOL_Spaces (Select_Mode);
- while (I < CurPtr) and ((Buffer^[I] in [#9,' '])) do
- Inc (I);
- if InsertText (@LineBreak[1], length(LineBreak), False) = FALSE then
- exit;
- if AutoIndent then
- InsertText (@Buffer^[P], I - P, False);
- { Remember where the CurPtr is at this moment. }
- { Remember the length of the buffer at the moment. }
- { Go to the previous line and remove EOL spaces. }
- { Once removed, re-set the cursor to where we were }
- { minus any spaces that might have been removed. }
- I := BufLen;
- P := CurPtr;
- SetCurPtr (LineMove (CurPtr, - 1), Select_Mode);
- Remove_EOL_Spaces (Select_Mode);
- if I - BufLen <> 0 then
- SetCurPtr (P - (I - BufLen), Select_Mode)
- else
- SetCurPtr (P, Select_Mode);
- NewLine:=true;
- end; { TEditor.NewLine }
- function TEditor.NextChar (P : Sw_Word) : Sw_Word;
- var
- pc : pchar;
- begin
- if P<>BufLen then
- begin
- inc(P);
- if P<>BufLen then
- begin
- pc:=pchar(Buffer);
- if P>=CurPtr then
- inc(pc,GapLen);
- inc(pc,P-1);
- if ord(pc^)+ord((pc+1)^)=23 then
- inc(p);
- end;
- end;
- NextChar:=P;
- end; { TEditor.NextChar }
- function TEditor.NextLine (P : Sw_Word) : Sw_Word;
- begin
- NextLine := NextChar (LineEnd (P));
- end; { TEditor.NextLine }
- function TEditor.NextWord (P : Sw_Word) : Sw_Word;
- begin
- { skip word }
- while (P < BufLen) and (BufChar (P) in WordChars) do
- P := NextChar (P);
- { skip spaces }
- while (P < BufLen) and not (BufChar (P) in WordChars) do
- P := NextChar (P);
- NextWord := P;
- end; { TEditor.NextWord }
- function TEditor.PrevChar (P : Sw_Word) : Sw_Word;
- var
- pc : pchar;
- begin
- if p<>0 then
- begin
- dec(p);
- if p<>0 then
- begin
- pc:=pchar(Buffer);
- if P>=CurPtr then
- inc(pc,GapLen);
- inc(pc,P-1);
- if ord(pc^)+ord((pc+1)^)=23 then
- dec(p);
- end;
- end;
- PrevChar:=P;
- end; { TEditor.PrevChar }
- function TEditor.PrevLine (P : Sw_Word) : Sw_Word;
- begin
- PrevLine := LineStart (PrevChar (P));
- end; { TEditor.PrevLine }
- function TEditor.PrevWord (P : Sw_Word) : Sw_Word;
- begin
- { skip spaces }
- while (P > 0) and not (BufChar (PrevChar (P)) in WordChars) do
- P := PrevChar (P);
- { skip word }
- while (P > 0) and (BufChar (PrevChar (P)) in WordChars) do
- P := PrevChar (P);
- PrevWord := P;
- end; { TEditor.PrevWord }
- procedure TEditor.Reformat_Document (Select_Mode : Byte; Center_Cursor : Boolean);
- { This procedure will do a reformat of the entire document, or just }
- { from the current line to the end of the document, if ^QU is pressed. }
- { It simply brings up the correct dialog box, and then calls the }
- { TEditor.Reformat_Paragraph procedure to do the actual reformatting. }
- CONST
- efCurrentLine = $0000; { Radio button #1 selection for dialog box. }
- efWholeDocument = $0001; { Radio button #2 selection for dialog box. }
- VAR
- Reformat_Options : Word; { Holds the dialog options for reformatting. }
- begin
- { Check if Word_Wrap is toggled on. If NOT on, check if programmer }
- { allows reformatting of document and if not show user dialog that }
- { says reformatting is not permissable. }
- if not Word_Wrap then
- begin
- if not Allow_Reformat then
- begin
- EditorDialog (edReformatNotAllowed, nil);
- Exit;
- end;
- Word_Wrap := True;
- Update (ufStats);
- end;
- { Default radio button option to 1st one. Bring up dialog box. }
- Reformat_Options := efCurrentLine;
- if EditorDialog (edReformatDocument, @Reformat_Options) <> cmCancel then
- begin
- { If the option to reformat the whole document was selected }
- { we need to go back to start of document. Otherwise we stay }
- { on the current line. Call Reformat_Paragraph until we get }
- { to the end of the document to do the reformatting. }
- if Reformat_Options and efWholeDocument <> 0 then
- SetCurPtr (0, Select_Mode);
- Unlock;
- repeat
- Lock;
- if NOT Reformat_Paragraph (Select_Mode, Center_Cursor) then
- Exit;
- TrackCursor (False);
- Unlock;
- until CurPtr = BufLen;
- end;
- end; { TEditor.Reformat_Document }
- function TEditor.Reformat_Paragraph (Select_Mode : Byte;
- Center_Cursor : Boolean) : Boolean;
- { This procedure will do a reformat of the current paragraph if ^B pressed. }
- { The feature works regardless if wordrap is on or off. It also supports }
- { the AutoIndent feature. Reformat is not possible if the CurPos exceeds }
- { the Right_Margin. Right_Margin is where the EOL is considered to be. }
- CONST
- Space : array [1..2] of Char = #32#32;
- VAR
- C : Sw_Word; { Position of CurPtr when we come into procedure. }
- E : Sw_Word; { End of a line. }
- S : Sw_Word; { Start of a line. }
- begin
- Reformat_Paragraph := False;
- { Check if Word_Wrap is toggled on. If NOT on, check if programmer }
- { allows reformatting of paragraph and if not show user dialog that }
- { says reformatting is not permissable. }
- if not Word_Wrap then
- begin
- if not Allow_Reformat then
- begin
- EditorDialog (edReformatNotAllowed, nil);
- Exit;
- end;
- Word_Wrap := True;
- Update (ufStats);
- end;
- C := CurPtr;
- E := LineEnd (CurPtr);
- S := LineStart (CurPtr);
- { Reformat possible only if current line is NOT blank! }
- if E <> S then
- begin
- { Reformat is NOT possible if the first word }
- { on the line is beyond the Right_Margin. }
- S := LineStart (CurPtr);
- if NextWord (S) - S >= Right_Margin - 1 then
- begin
- EditorDialog (edReformNotPossible, nil);
- Exit;
- end;
- { First objective is to find the first blank line }
- { after this paragraph so we know when to stop. }
- { That could be the end of the document. }
- Repeat
- SetCurPtr (LineMove (CurPtr, 1), Select_Mode);
- E := LineEnd (CurPtr);
- S := LineStart (CurPtr);
- BlankLine := E;
- until ((CurPtr = BufLen) or (E = S));
- SetCurPtr (C, Select_Mode);
- repeat
- { Set CurPtr to LineEnd and remove the EOL spaces. }
- { Pull up the next line and remove its EOL space. }
- { First make sure the next line is not BlankLine! }
- { Insert spaces as required between the two lines. }
- SetCurPtr (LineEnd (CurPtr), Select_Mode);
- Remove_EOL_Spaces (Select_Mode);
- if CurPtr <> Blankline - 2 then
- DeleteRange (CurPtr, Nextword (CurPtr), True);
- Remove_EOL_Spaces (Select_Mode);
- case Buffer^[CurPtr-1] of
- '!' : InsertText (@Space, 2, False);
- '.' : InsertText (@Space, 2, False);
- ':' : InsertText (@Space, 2, False);
- '?' : InsertText (@Space, 2, False);
- else
- InsertText (@Space, 1, False);
- end;
- { Reset CurPtr to EOL. While line length is > Right_Margin }
- { go Do_Word_Wrap. If wordrap failed, exit routine. }
- SetCurPtr (LineEnd (CurPtr), Select_Mode);
- while LineEnd (CurPtr) - LineStart (CurPtr) > Right_Margin do
- if not Do_Word_Wrap (Select_Mode, Center_Cursor) then
- Exit;
- { If LineEnd - LineStart > Right_Margin then set CurPtr }
- { to Right_Margin on current line. Otherwise we set the }
- { CurPtr to LineEnd. This gyration sets up the conditions }
- { to test for time of loop exit. }
- if LineEnd (CurPtr) - LineStart (CurPtr) > Right_Margin then
- SetCurPtr (LineStart (CurPtr) + Right_Margin, Select_Mode)
- else
- SetCurPtr (LineEnd (CurPtr), Select_Mode);
- until ((CurPtr >= BufLen) or (CurPtr >= BlankLine - 2));
- end;
- { If not at the end of the document reset CurPtr to start of next line. }
- { This should be a blank line between paragraphs. }
- if CurPtr < BufLen then
- SetCurPtr (LineMove (CurPtr, 1), Select_Mode);
- Reformat_Paragraph := True;
- end; { TEditor.Reformat_Paragraph }
- procedure TEditor.Remove_EOL_Spaces (Select_Mode : Byte);
- { This procedure tests to see if there are consecutive spaces }
- { at the end of a line (EOL). If so, we delete all spaces }
- { after the last non-space character to the end of line. }
- { We then reset the CurPtr to where we ended up at. }
- VAR
- C : Sw_Word; { Current pointer when we come into procedure. }
- E : Sw_Word; { End of line. }
- P : Sw_Word; { Position of pointer at any given moment. }
- S : Sw_Word; { Start of a line. }
- begin
- C := CurPtr;
- E := LineEnd (CurPtr);
- P := E;
- S := LineStart (CurPtr);
- { Start at the end of a line and move towards the start. }
- { Find first non-space character in that direction. }
- while (P > S) and (BufChar (PrevChar (P)) = #32) do
- P := PrevChar (P);
- { If we found any spaces then delete them. }
- if P < E then
- begin
- SetSelect (P, E, True);
- DeleteSelect;
- Update_Place_Markers (0, E - P, P, E);
- end;
- { If C, our pointer when we came into this procedure, }
- { is less than the CurPtr then reset CurPtr to C so }
- { cursor is where we started. Otherwise, set it to }
- { the new CurPtr, for we have deleted characters. }
- if C < CurPtr then
- SetCurPtr (C, Select_Mode)
- else
- SetCurPtr (CurPtr, Select_Mode);
- end; { TEditor.Remove_EOL_Spaces }
- procedure TEditor.Replace;
- VAR
- ReplaceRec : TReplaceDialogRec;
- begin
- with ReplaceRec do
- begin
- Find := FindStr;
- Replace := ReplaceStr;
- Options := Flags;
- if EditorDialog (edReplace, @ReplaceRec) <> cmCancel then
- begin
- FindStr := Find;
- ReplaceStr := Replace;
- Flags := Options or efDoReplace;
- DoSearchReplace;
- end;
- end;
- end; { TEditor.Replace }
- procedure TEditor.Scroll_Down;
- { This procedure will scroll the screen up, and always keep }
- { the cursor on the CurPos.Y position, but not necessarily on }
- { the CurPos.X. If CurPos.Y scrolls off the screen, the cursor }
- { will stay in the upper left corner of the screen. This will }
- { simulate the same process in the IDE. The CurPos.X coordinate }
- { only messes up if we are on long lines and we then encounter }
- { a shorter or blank line beneath the current one as we scroll. }
- { In that case, it goes to the end of the new line. }
- VAR
- C : Sw_Word; { Position of CurPtr when we enter procedure. }
- P : Sw_Word; { Position of CurPtr at any given time. }
- W : Objects.TPoint; { CurPos.Y of CurPtr and P ('.X and '.Y). }
- begin
- { Remember current cursor position. Remember current CurPos.Y position. }
- { Now issue the equivalent of a [Ctrl]-[End] command so the cursor will }
- { go to the bottom of the current screen. Reset the cursor to this new }
- { position and then send FALSE to TrackCursor so we fool it into }
- { incrementing Delta.Y by only +1. If we didn't do this it would try }
- { to center the cursor on the screen by fiddling with Delta.Y. }
- C := CurPtr;
- W.X := CurPos.Y;
- P := LineMove (CurPtr, Delta.Y - CurPos.Y + Size.Y);
- SetCurPtr (P, 0);
- TrackCursor (False);
- { Now remember where the new CurPos.Y is. See if distance between new }
- { CurPos.Y and old CurPos.Y are greater than the current screen size. }
- { If they are, we need to move cursor position itself down by one. }
- { Otherwise, send the cursor back to our original CurPtr. }
- W.Y := CurPos.Y;
- if W.Y - W.X > Size.Y - 1 then
- SetCurPtr (LineMove (C, 1), 0)
- else
- SetCurPtr (C, 0);
- end; { TEditor.Scroll_Down }
- procedure TEditor.Scroll_Up;
- { This procedure will scroll the screen down, and always keep }
- { the cursor on the CurPos.Y position, but not necessarily on }
- { the CurPos.X. If CurPos.Y scrolls off the screen, the cursor }
- { will stay in the bottom left corner of the screen. This will }
- { simulate the same process in the IDE. The CurPos.X coordinate }
- { only messes up if we are on long lines and we then encounter }
- { a shorter or blank line beneath the current one as we scroll. }
- { In that case, it goes to the end of the new line. }
- VAR
- C : Sw_Word; { Position of CurPtr when we enter procedure. }
- P : Sw_Word; { Position of CurPtr at any given time. }
- W : Objects.TPoint; { CurPos.Y of CurPtr and P ('.X and '.Y). }
- begin
- { Remember current cursor position. Remember current CurPos.Y position. }
- { Now issue the equivalent of a [Ctrl]-[Home] command so the cursor will }
- { go to the top of the current screen. Reset the cursor to this new }
- { position and then send FALSE to TrackCursor so we fool it into }
- { decrementing Delta.Y by only -1. If we didn't do this it would try }
- { to center the cursor on the screen by fiddling with Delta.Y. }
- C := CurPtr;
- W.Y := CurPos.Y;
- P := LineMove (CurPtr, -(CurPos.Y - Delta.Y + 1));
- SetCurPtr (P, 0);
- TrackCursor (False);
- { Now remember where the new CurPos.Y is. See if distance between new }
- { CurPos.Y and old CurPos.Y are greater than the current screen size. }
- { If they are, we need to move the cursor position itself up by one. }
- { Otherwise, send the cursor back to our original CurPtr. }
- W.X := CurPos.Y;
- if W.Y - W.X > Size.Y - 1 then
- SetCurPtr (LineMove (C, -1), 0)
- else
- SetCurPtr (C, 0);
- end; { TEditor.Scroll_Up }
- procedure TEditor.ScrollTo (X, Y : Sw_Integer);
- begin
- X := Max (0, Min (X, Limit.X - Size.X));
- Y := Max (0, Min (Y, Limit.Y - Size.Y));
- if (X <> Delta.X) or (Y <> Delta.Y) then
- begin
- Delta.X := X;
- Delta.Y := Y;
- Update (ufView);
- end;
- end; { TEditor.ScrollTo }
- function TEditor.Search (const FindStr : String; Opts : Word) : Boolean;
- VAR
- I,Pos : Sw_Word;
- begin
- Search := False;
- Pos := CurPtr;
- repeat
- if Opts and efCaseSensitive <> 0 then
- I := Scan (Buffer^[BufPtr (Pos)], BufLen - Pos, FindStr)
- else
- I := IScan (Buffer^[BufPtr (Pos)], BufLen - Pos, FindStr);
- if (I <> sfSearchFailed) then
- begin
- Inc (I, Pos);
- if (Opts and efWholeWordsOnly = 0) or
- not (((I <> 0) and (BufChar (I - 1) in WordChars)) or
- ((I + Length (FindStr) <> BufLen) and
- (BufChar (I + Length (FindStr)) in WordChars))) then
- begin
- Lock;
- SetSelect (I, I + Length (FindStr), False);
- TrackCursor (not CursorVisible);
- Unlock;
- Search := True;
- Exit;
- end
- else
- Pos := I + 1;
- end;
- until I = sfSearchFailed;
- end; { TEditor.Search }
- procedure TEditor.Select_Word;
- { This procedure will select the a word to put into the clipboard. }
- { I've added it just to maintain compatibility with the IDE editor. }
- { Note that selection starts at the current cursor position and ends }
- { when a space or the end of line is encountered. }
- VAR
- E : Sw_Word; { End of the current line. }
- Select_Mode : Byte; { Allows us to turn select mode on inside procedure. }
- begin
- E := LineEnd (CurPtr);
- { If the cursor is on a space or at the end of a line, abort. }
- { Stupid action on users part for you can't select blanks! }
- if (BufChar (CurPtr) = #32) or (CurPtr = E) then
- Exit;
- { Turn on select mode and tell editor to start selecting text. }
- { As long as we have a character > a space (this is done to }
- { exclude CR/LF pairs at end of a line) and we are NOT at the }
- { end of a line, set the CurPtr to the next character. }
- { Once we find a space or CR/LF, selection is done and we }
- { automatically put the selected word into the Clipboard. }
- Select_Mode := smExtend;
- StartSelect;
- while (BufChar (NextChar (CurPtr)) > #32) and (CurPtr < E) do
- SetCurPtr (NextChar (CurPtr), Select_Mode);
- SetCurPtr (NextChar (CurPtr), Select_Mode);
- ClipCopy;
- end; {TEditor.Select_Word }
- procedure TEditor.SetBufLen (Length : Sw_Word);
- begin
- BufLen := Length;
- GapLen := BufSize - Length;
- SelStart := 0;
- SelEnd := 0;
- CurPtr := 0;
- CurPos.X:=0;
- CurPos.Y:=0;
- Delta.X:=0;
- Delta.Y:=0;
- GetLimits(Buffer^[GapLen], BufLen,Limit);
- inc(Limit.X);
- inc(Limit.Y);
- DrawLine := 0;
- DrawPtr := 0;
- DelCount := 0;
- InsCount := 0;
- Modified := False;
- Update (ufView);
- end; { TEditor.SetBufLen }
- function TEditor.SetBufSize (NewSize : Sw_Word) : Boolean;
- begin
- ReAllocMem(Buffer, NewSize);
- BufSize := NewSize;
- SetBufSize := True;
- end; { TEditor.SetBufSize }
- procedure TEditor.SetCmdState (Command : Word; Enable : Boolean);
- VAR
- S : TCommandSet;
- begin
- S := [Command];
- if Enable and (State and sfActive <> 0) then
- EnableCommands (S)
- else
- DisableCommands (S);
- end; { TEditor.SetCmdState }
- procedure TEditor.SetCurPtr (P : Sw_Word; SelectMode : Byte);
- VAR
- Anchor : Sw_Word;
- begin
- if SelectMode and smExtend = 0 then
- Anchor := P
- else
- if CurPtr = SelStart then
- Anchor := SelEnd
- else
- Anchor := SelStart;
- if P < Anchor then
- begin
- if SelectMode and smDouble <> 0 then
- begin
- P := PrevLine (NextLine (P));
- Anchor := NextLine (PrevLine (Anchor));
- end;
- SetSelect (P, Anchor, True);
- end
- else
- begin
- if SelectMode and smDouble <> 0 then
- begin
- P := NextLine (P);
- Anchor := PrevLine (NextLine (Anchor));
- end;
- SetSelect (Anchor, P, False);
- end;
- end; { TEditor.SetCurPtr }
- procedure TEditor.Set_Place_Marker (Element : Byte);
- { This procedure sets a place marker for the CurPtr if ^K# is pressed. }
- begin
- if not IsClipboard then
- Place_Marker[Element] := CurPtr;
- end; { TEditor.Set_Place_Marker }
- procedure TEditor.Set_Right_Margin;
- { This procedure will bring up a dialog box }
- { that allows the user to set Right_Margin. }
- { Values must be < MaxLineLength and > 9. }
- VAR
- Code : Integer; { Used for Val conversion. }
- Margin_Data : TRightMarginRec; { Holds dialog results. }
- Temp_Value : Sw_Integer; { Holds converted dialog value. }
- begin
- with Margin_Data do
- begin
- Str (Right_Margin, Margin_Position);
- if EditorDialog (edRightMargin, @Margin_Position) <> cmCancel then
- begin
- val (Margin_Position, Temp_Value, Code);
- if (Temp_Value <= MaxLineLength) and (Temp_Value > 9) then
- Right_Margin := Temp_Value;
- end;
- end;
- end; { TEditor.Set_Right_Margin }
- procedure TEditor.SetSelect (NewStart, NewEnd : Sw_Word; CurStart : Boolean);
- VAR
- UFlags : Byte;
- P : Sw_Word;
- L : Sw_Word;
- begin
- if CurStart then
- P := NewStart
- else
- P := NewEnd;
- UFlags := ufUpdate;
- if (NewStart <> SelStart) or (NewEnd <> SelEnd) then
- if (NewStart <> NewEnd) or (SelStart <> SelEnd) then
- UFlags := ufView;
- if P <> CurPtr then
- begin
- if P > CurPtr then
- begin
- L := P - CurPtr;
- Move (Buffer^[CurPtr + GapLen], Buffer^[CurPtr], L);
- Inc (CurPos.Y, CountLines (Buffer^[CurPtr], L));
- CurPtr := P;
- end
- else
- begin
- L := CurPtr - P;
- CurPtr := P;
- Dec (CurPos.Y, CountLines (Buffer^[CurPtr], L));
- Move (Buffer^[CurPtr], Buffer^[CurPtr + GapLen], L);
- end;
- DrawLine := CurPos.Y;
- DrawPtr := LineStart (P);
- CurPos.X := CharPos (DrawPtr, P);
- DelCount := 0;
- InsCount := 0;
- SetBufSize (BufLen);
- end;
- SelStart := NewStart;
- SelEnd := NewEnd;
- Update (UFlags);
- end; { TEditor.Select }
- procedure TEditor.SetState (AState : Word; Enable : Boolean);
- begin
- Inherited SetState (AState, Enable);
- case AState of
- sfActive: begin
- if assigned(HScrollBar) then
- HScrollBar^.SetState (sfVisible, Enable);
- if assigned(VScrollBar) then
- VScrollBar^.SetState (sfVisible, Enable);
- if assigned(Indicator) then
- Indicator^.SetState (sfVisible, Enable);
- UpdateCommands;
- end;
- sfExposed: if Enable then Unlock;
- end;
- end; { TEditor.SetState }
- procedure TEditor.Set_Tabs;
- { This procedure will bring up a dialog box }
- { that allows the user to set tab stops. }
- VAR
- Index : Sw_Integer; { Index into string array. }
- Tab_Data : TTabStopRec; { Holds dialog results. }
- begin
- with Tab_Data do
- begin
- { Assign current Tab_Settings to Tab_String. }
- { Bring up the tab dialog so user can set tabs. }
- Tab_String := Copy (Tab_Settings, 1, Tab_Stop_Length);
- if EditorDialog (edSetTabStops, @Tab_String) <> cmCancel then
- begin
- { If Tab_String comes back as empty then set Tab_Settings to nil. }
- { Otherwise, find the last character in Tab_String that is not }
- { a space and copy Tab_String into Tab_Settings up to that spot. }
- if Length (Tab_String) = 0 then
- begin
- FillChar (Tab_Settings, SizeOf (Tab_Settings), #0);
- Tab_Settings[0] := #0;
- Exit;
- end
- else
- begin
- Index := Length (Tab_String);
- while Tab_String[Index] <= #32 do
- Dec (Index);
- Tab_Settings := Copy (Tab_String, 1, Index);
- end;
- end;
- end;
- end; { TEditor.Set_Tabs }
- procedure TEditor.StartSelect;
- begin
- HideSelect;
- Selecting := True;
- end; { TEditor.StartSelect }
- procedure TEditor.Store (var S : Objects.TStream);
- begin
- Inherited Store (S);
- PutPeerViewPtr (S, HScrollBar);
- PutPeerViewPtr (S, VScrollBar);
- PutPeerViewPtr (S, Indicator);
- S.Write (BufSize, SizeOf (BufSize));
- S.Write (Canundo, SizeOf (Canundo));
- S.Write (AutoIndent, SizeOf (AutoIndent));
- S.Write (Line_Number, SizeOf (Line_Number));
- S.Write (Place_Marker, SizeOf (Place_Marker));
- S.Write (Right_Margin, SizeOf (Right_Margin));
- S.Write (Tab_Settings, SizeOf (Tab_Settings));
- S.Write (Word_Wrap, SizeOf (Word_Wrap));
- end; { Editor.Store }
- procedure TEditor.Tab_Key (Select_Mode : Byte);
- { This function determines if we are in overstrike or insert mode, }
- { and then moves the cursor if overstrike, or adds spaces if insert. }
- VAR
- E : Sw_Word; { End of current line. }
- Index : Sw_Integer; { Loop counter. }
- Position : Sw_Integer; { CurPos.X position. }
- S : Sw_Word; { Start of current line. }
- Spaces : array [1..80] of Char; { Array to hold spaces for insertion. }
- begin
- E := LineEnd (CurPtr);
- S := LineStart (CurPtr);
- { Find the current horizontal cursor position. }
- { Now loop through the Tab_Settings string and }
- { find the next available tab stop. }
- Position := CurPos.X + 1;
- repeat
- Inc (Position);
- until (Tab_Settings[Position] <> #32) or (Position >= Ord (Tab_Settings[0]));
- E := CurPos.X;
- Index := 1;
- { Now we enter a loop to go to the next tab position. }
- { If we are in overwrite mode, we just move the cursor }
- { through the text to the next tab stop. If we are in }
- { insert mode, we add spaces to the Spaces array for }
- { the number of times we loop. }
- while Index < Position - E do
- begin
- if Overwrite then
- begin
- if (Position > LineEnd (CurPtr) - LineStart (CurPtr))
- or (Position > Ord (Tab_Settings[0])) then
- begin
- SetCurPtr (LineStart (LineMove (CurPtr, 1)), Select_Mode);
- Exit;
- end
- else
- if CurPtr < BufLen then
- SetCurPtr (NextChar (CurPtr), Select_Mode);
- end
- else
- begin
- if (Position > Right_Margin) or (Position > Ord (Tab_Settings[0])) then
- begin
- SetCurPtr (LineStart (LineMove (CurPtr, 1)), Select_Mode);
- Exit;
- end
- else
- Spaces[Index] := #32;
- end;
- Inc (Index);
- end;
- { If we are insert mode, we insert spaces to the next tab stop. }
- { When we're all done, the cursor will be sitting on the new tab stop. }
- if not OverWrite then
- InsertText (@Spaces, Index - 1, False);
- end; { TEditor.Tab_Key }
- procedure TEditor.ToggleInsMode;
- begin
- Overwrite := not Overwrite;
- SetState (sfCursorIns, not GetState (sfCursorIns));
- end; { TEditor.ToggleInsMode }
- procedure TEditor.TrackCursor (Center : Boolean);
- begin
- if Center then
- ScrollTo (CurPos.X - Size.X + 1, CurPos.Y - Size.Y div 2)
- else
- ScrollTo (Max (CurPos.X - Size.X + 1, Min (Delta.X, CurPos.X)),
- Max (CurPos.Y - Size.Y + 1, Min (Delta.Y, CurPos.Y)));
- end; { TEditor.TrackCursor }
- procedure TEditor.Undo;
- VAR
- Length : Sw_Word;
- begin
- if (DelCount <> 0) or (InsCount <> 0) then
- begin
- Update_Place_Markers (DelCount, 0, CurPtr, CurPtr + DelCount);
- SelStart := CurPtr - InsCount;
- SelEnd := CurPtr;
- Length := DelCount;
- DelCount := 0;
- InsCount := 0;
- InsertBuffer (Buffer, CurPtr + GapLen - Length, Length, False, True);
- end;
- end; { TEditor.Undo }
- procedure TEditor.Unlock;
- begin
- if LockCount > 0 then
- begin
- Dec (LockCount);
- if LockCount = 0 then
- DoUpdate;
- end;
- end; { TEditor.Unlock }
- procedure TEditor.Update (AFlags : Byte);
- begin
- UpdateFlags := UpdateFlags or AFlags;
- if LockCount = 0 then
- DoUpdate;
- end; { TEditor.Update }
- procedure TEditor.UpdateCommands;
- begin
- SetCmdState (cmUndo, (DelCount <> 0) or (InsCount <> 0));
- if not IsClipboard then
- begin
- SetCmdState (cmCut, HasSelection);
- SetCmdState (cmCopy, HasSelection);
- SetCmdState (cmPaste, assigned(Clipboard) and (Clipboard^.HasSelection));
- end;
- SetCmdState (cmClear, HasSelection);
- SetCmdState (cmFind, True);
- SetCmdState (cmReplace, True);
- SetCmdState (cmSearchAgain, True);
- end; { TEditor.UpdateCommands }
- procedure TEditor.Update_Place_Markers (AddCount : Word; KillCount : Word;
- StartPtr,EndPtr : Sw_Word);
- { This procedure updates the position of the place markers }
- { as the user inserts and deletes text in the document. }
- VAR
- Element : Byte; { Place_Marker array element to traverse array with. }
- begin
- for Element := 1 to 10 do
- begin
- if AddCount > 0 then
- begin
- if (Place_Marker[Element] >= Curptr)
- and (Place_Marker[Element] <> 0) then
- Place_Marker[Element] := Place_Marker[Element] + AddCount;
- end
- else
- begin
- if Place_Marker[Element] >= StartPtr then
- begin
- if (Place_Marker[Element] >= StartPtr) and
- (Place_Marker[Element] < EndPtr) then
- Place_marker[Element] := 0
- else
- begin
- if integer (Place_Marker[Element]) - integer (KillCount) > 0 then
- Place_Marker[Element] := Place_Marker[Element] - KillCount
- else
- Place_Marker[Element] := 0;
- end;
- end;
- end;
- end;
- if AddCount > 0 then
- BlankLine := BlankLine + AddCount
- else
- begin
- if integer (BlankLine) - Integer (KillCount) > 0 then
- BlankLine := BlankLine - KillCount
- else
- BlankLine := 0;
- end;
- end; { TEditor.Update_Place_Markers }
- function TEditor.Valid (Command : Word) : Boolean;
- begin
- Valid := IsValid;
- end; { TEditor.Valid }
- {****************************************************************************
- TMEMO
- ****************************************************************************}
- constructor TMemo.Load (var S : Objects.TStream);
- VAR
- Length : Sw_Word;
- begin
- Inherited Load (S);
- S.Read (Length, SizeOf (Length));
- if IsValid then
- begin
- S.Read (Buffer^[BufSize - Length], Length);
- SetBufLen (Length);
- end
- else
- S.Seek (S.GetPos + Length);
- end; { TMemo.Load }
- function TMemo.DataSize : Sw_Word;
- begin
- DataSize := BufSize + SizeOf (Sw_Word);
- end; { TMemo.DataSize }
- procedure TMemo.GetData (var Rec);
- VAR
- Data : TMemoData absolute Rec;
- begin
- Data.Length := BufLen;
- Move (Buffer^, Data.Buffer, CurPtr);
- Move (Buffer^[CurPtr + GapLen], Data.Buffer[CurPtr], BufLen - CurPtr);
- FillChar (Data.Buffer[BufLen], BufSize - BufLen, 0);
- end; { TMemo.GetData }
- function TMemo.GetPalette : PPalette;
- CONST
- P : String[Length (CMemo)] = CMemo;
- begin
- GetPalette := PPalette(@P);
- end; { TMemo.GetPalette }
- procedure TMemo.HandleEvent (var Event : Drivers.TEvent);
- begin
- if (Event.What <> Drivers.evKeyDown) or (Event.KeyCode <> Drivers.kbTab) then
- Inherited HandleEvent (Event);
- end; { TMemo.HandleEvent }
- procedure TMemo.SetData (var Rec);
- VAR
- Data : TMemoData absolute Rec;
- begin
- Move (Data.Buffer, Buffer^[BufSize - Data.Length], Data.Length);
- SetBufLen (Data.Length);
- end; { TMemo.SetData }
- procedure TMemo.Store (var S : Objects.TStream);
- begin
- Inherited Store (S);
- S.Write (BufLen, SizeOf (BufLen));
- S.Write (Buffer^, CurPtr);
- S.Write (Buffer^[CurPtr + GapLen], BufLen - CurPtr);
- end; { TMemo.Store }
- {****************************************************************************
- TFILEEDITOR
- ****************************************************************************}
- constructor TFileEditor.Init (var Bounds : TRect;
- AHScrollBar, AVScrollBar : PScrollBar;
- AIndicator : PIndicator;
- AFileName : FNameStr);
- begin
- Inherited Init (Bounds, AHScrollBar, AVScrollBar, AIndicator, 0);
- if AFileName <> '' then
- begin
- FileName := FExpand (AFileName);
- if IsValid then
- IsValid := LoadFile;
- end;
- end; { TFileEditor.Init }
- constructor TFileEditor.Load (var S : Objects.TStream);
- VAR
- SStart,SEnd,Curs : Sw_Word;
- begin
- Inherited Load (S);
- BufSize := 0;
- S.Read (FileName[0], SizeOf (Byte));
- S.Read (Filename[1], Length (FileName));
- if IsValid then
- IsValid := LoadFile;
- S.Read (SStart, SizeOf (SStart));
- S.Read (SEnd, SizeOf (SEnd));
- S.Read (Curs, SizeOf (Curs));
- if IsValid and (SEnd <= BufLen) then
- begin
- SetSelect (SStart, SEnd, Curs = SStart);
- TrackCursor (True);
- end;
- end; { TFileEditor.Load }
- procedure TFileEditor.DoneBuffer;
- begin
- ReAllocMem(Buffer, 0);
- end; { TFileEditor.DoneBuffer }
- procedure TFileEditor.HandleEvent (var Event : Drivers.TEvent);
- begin
- Inherited HandleEvent (Event);
- case Event.What of
- Drivers.evCommand:
- case Event.Command of
- cmSave : Save;
- cmSaveAs : SaveAs;
- cmSaveDone : if Save then
- Message (Owner, Drivers.evCommand, cmClose, nil);
- else
- Exit;
- end;
- else
- Exit;
- end;
- ClearEvent (Event);
- end; { TFileEditor.HandleEvent }
- procedure TFileEditor.InitBuffer;
- begin
- Assert(Buffer = nil, 'TFileEditor.InitBuffer: Buffer is not nil');
- ReAllocMem(Buffer, MinBufLength);
- BufSize := MinBufLength;
- end; { TFileEditor.InitBuffer }
- function TFileEditor.LoadFile: Boolean;
- VAR
- Length : Sw_Word;
- FSize : Longint;
- FRead : Sw_Integer;
- F : File;
- begin
- LoadFile := False;
- Length := 0;
- Assign(F, FileName);
- Reset(F, 1);
- if IOResult <> 0 then
- EditorDialog(edReadError, @FileName)
- else
- begin
- FSize := FileSize(F);
- if (FSize > MaxBufLength) or not SetBufSize(FSize) then
- EditorDialog(edOutOfMemory, nil)
- else
- begin
- BlockRead(F, Buffer^[BufSize-FSize], FSize, FRead);
- if (IOResult <> 0) or (FRead<>FSize) then
- EditorDialog(edReadError, @FileName)
- else
- begin
- LoadFile := True;
- Length := FRead;
- end;
- end;
- Close(F);
- end;
- SetBufLen(Length);
- end; { TFileEditor.LoadFile }
- function TFileEditor.Save : Boolean;
- begin
- if FileName = '' then
- Save := SaveAs
- else
- Save := SaveFile;
- end; { TFileEditor.Save }
- function TFileEditor.SaveAs : Boolean;
- begin
- SaveAs := False;
- if EditorDialog (edSaveAs, @FileName) <> cmCancel then
- begin
- FileName := FExpand (FileName);
- Message (Owner, Drivers.evBroadcast, cmUpdateTitle, nil);
- SaveAs := SaveFile;
- if IsClipboard then
- FileName := '';
- end;
- end; { TFileEditor.SaveAs }
- function TFileEditor.SaveFile : Boolean;
- VAR
- F : File;
- BackupName : Objects.FNameStr;
- D : DOS.DirStr;
- N : DOS.NameStr;
- E : DOS.ExtStr;
- begin
- SaveFile := False;
- if Flags and efBackupFiles <> 0 then
- begin
- FSplit (FileName, D, N, E);
- BackupName := D + N + '.bak';
- Assign (F, BackupName);
- Erase (F);
- Assign (F, FileName);
- Rename (F, BackupName);
- InOutRes := 0;
- end;
- Assign (F, FileName);
- Rewrite (F, 1);
- if IOResult <> 0 then
- EditorDialog (edCreateError, @FileName)
- else
- begin
- BlockWrite (F, Buffer^, CurPtr);
- BlockWrite (F, Buffer^[CurPtr + GapLen], BufLen - CurPtr);
- if IOResult <> 0 then
- EditorDialog (edWriteError, @FileName)
- else
- begin
- Modified := False;
- Update (ufUpdate);
- SaveFile := True;
- end;
- Close (F);
- end;
- end; { TFileEditor.SaveFile }
- function TFileEditor.SetBufSize (NewSize : Sw_Word) : Boolean;
- VAR
- N : Sw_Word;
- begin
- SetBufSize := False;
- if NewSize = 0 then
- NewSize := MinBufLength
- else
- if NewSize > (MaxBufLength-MinBufLength) then
- NewSize := MaxBufLength
- else
- NewSize := (NewSize + (MinBufLength-1)) and (MaxBufLength and (not (MinBufLength-1)));
- if NewSize <> BufSize then
- begin
- if NewSize > BufSize then ReAllocMem(Buffer, NewSize);
- N := BufLen - CurPtr + DelCount;
- Move(Buffer^[BufSize - N], Buffer^[NewSize - N], N);
- if NewSize < BufSize then ReAllocMem(Buffer, NewSize);
- BufSize := NewSize;
- GapLen := BufSize - BufLen;
- end;
- SetBufSize := True;
- end; { TFileEditor.SetBufSize }
- procedure TFileEditor.Store (var S : Objects.TStream);
- begin
- Inherited Store (S);
- S.Write (FileName, Length (FileName) + 1);
- S.Write (SelStart, SizeOf (SelStart));
- S.Write (SelEnd, SizeOf (SelEnd));
- S.Write (CurPtr, SizeOf (CurPtr));
- end; { TFileEditor.Store }
- procedure TFileEditor.UpdateCommands;
- begin
- Inherited UpdateCommands;
- SetCmdState (cmSave, True);
- SetCmdState (cmSaveAs, True);
- SetCmdState (cmSaveDone, True);
- end; { TFileEditor.UpdateCommands }
- function TFileEditor.Valid (Command : Word) : Boolean;
- VAR
- D : Integer;
- begin
- if Command = cmValid then
- Valid := IsValid
- else
- begin
- Valid := True;
- if Modified then
- begin
- if FileName = '' then
- D := edSaveUntitled
- else
- D := edSaveModify;
- case EditorDialog (D, @FileName) of
- cmYes : Valid := Save;
- cmNo : Modified := False;
- cmCancel : Valid := False;
- end;
- end;
- end;
- end; { TFileEditor.Valid }
- {****************************************************************************
- TEDITWINDOW
- ****************************************************************************}
- constructor TEditWindow.Init (var Bounds : TRect;
- FileName : Objects.FNameStr;
- ANumber : Integer);
- var
- HScrollBar : PScrollBar;
- VScrollBar : PScrollBar;
- Indicator : PIndicator;
- R : TRect;
- begin
- Inherited Init (Bounds, '', ANumber);
- Options := Options or ofTileable;
- R.Assign (18, Size.Y - 1, Size.X - 2, Size.Y);
- HScrollBar := New (PScrollBar, Init (R));
- HScrollBar^.Hide;
- Insert (HScrollBar);
- R.Assign (Size.X - 1, 1, Size.X, Size.Y - 1);
- VScrollBar := New (PScrollBar, Init (R));
- VScrollBar^.Hide;
- Insert (VScrollBar);
- R.Assign (2, Size.Y - 1, 16, Size.Y);
- Indicator := New (PIndicator, Init (R));
- Indicator^.Hide;
- Insert (Indicator);
- GetExtent (R);
- R.Grow (-1, -1);
- Editor := New (PFileEditor, Init (R, HScrollBar, VScrollBar, Indicator, FileName));
- Insert (Editor);
- end; { TEditWindow.Init }
- constructor TEditWindow.Load (var S : Objects.TStream);
- begin
- Inherited Load (S);
- GetSubViewPtr (S, Editor);
- end; { TEditWindow.Load }
- procedure TEditWindow.Close;
- begin
- if Editor^.IsClipboard then
- Hide
- else
- Inherited Close;
- end; { TEditWindow.Close }
- function TEditWindow.GetTitle (MaxSize : Sw_Integer) : TTitleStr;
- begin
- if Editor^.IsClipboard then
- GetTitle := sClipboard
- else
- if Editor^.FileName = '' then
- GetTitle := sUntitled
- else
- GetTitle := Editor^.FileName;
- end; { TEditWindow.GetTile }
- procedure TEditWindow.HandleEvent (var Event : Drivers.TEvent);
- begin
- Inherited HandleEvent (Event);
- if (Event.What = Drivers.evBroadcast) then
- { and (Event.Command = cmUpdateTitle) then }
- { Changed if statement above so I could test for cmBlugeonStats. }
- { Stats would not show up when loading a file until a key was pressed. }
- case Event.Command of
- cmUpdateTitle :
- begin
- Frame^.DrawView;
- ClearEvent (Event);
- end;
- cmBludgeonStats :
- begin
- Editor^.Update (ufStats);
- ClearEvent (Event);
- end;
- end;
- end; { TEditWindow.HandleEvent }
- procedure TEditWindow.SizeLimits(var Min, Max: TPoint);
- begin
- inherited SizeLimits(Min, Max);
- Min.X := 23;
- end;
- procedure TEditWindow.Store (var S : Objects.TStream);
- begin
- Inherited Store (S);
- PutSubViewPtr (S, Editor);
- end; { TEditWindow.Store }
- procedure RegisterEditors;
- begin
- RegisterType (REditor);
- RegisterType (RMemo);
- RegisterType (RFileEditor);
- RegisterType (RIndicator);
- RegisterType (REditWindow);
- end; { RegisterEditors }
- end. { Unit NewEdit }
|