123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735 |
- 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}
- 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 = packed record
- Find : String[80];
- Options : Word;
- end;
- TReplaceDialogRec = packed record
- Find : String[80];
- Replace : String[80];
- Options : Word;
- end;
- TRightMarginRec = packed record
- Margin_Position : String[3];
- end;
- TTabStopRec = packed 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
- Memory, Dos, App, StdDlg, MsgBox, Resource;
- type
- pword = ^word;
- 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, strings^.get(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, labels^.get(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 (labels^.get(slCaseSensitive),
- NewSItem (labels^.get(slWholeWordsOnly),nil))));
- Control^.HelpCtx := hcCCaseSensitive;
- Insert(Control);
- R.Assign(14, 9, 24, 11);
- Control := New (PButton, Init(R,labels^.get(slOK),cmOk,bfDefault));
- Control^.HelpCtx := hcDOk;
- Insert (Control);
- Inc(R.A.X, 12); Inc(R.B.X, 12);
- Control := New (PButton, Init(R,labels^.get(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,labels^.get(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,labels^.get(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,labels^.get(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 (labels^.get(slCasesensitive),
- NewSItem (labels^.get(slWholewordsonly),
- NewSItem (labels^.get(slPromptonreplace),
- NewSItem (labels^.get(slReplaceall), nil))))));
- Control^.HelpCtx := hcCCaseSensitive;
- Insert (Control);
- R.Assign (8, 13, 18, 15);
- Control := New (PButton, Init (R,labels^.get(slOK), cmOk, bfDefault));
- Control^.HelpCtx := hcDOk;
- Insert (Control);
- R.Assign (22, 13, 32, 15);
- Control := New (PButton, Init (R,labels^.get(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,strings^.get(sJumpTo)));
- with D^ do
- begin
- Options := Options or ofCentered;
- R.Assign (3, 2, 15, 3);
- Control := New (Dialogs.PStaticText, Init (R,labels^.get(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, labels^.get(slOK), cmOK, Dialogs.bfDefault));
- Control^.HelpCtx := hcDOk;
- Insert (Control);
- R.Assign (14, 5, 24, 7);
- Control := New (Dialogs.PButton, Init (R, labels^.get(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, strings^.get(sReformatDocument)));
- with D^ do
- begin
- Options := Options or ofCentered;
- R.Assign (2, 2, 30, 3);
- Control := New (Dialogs.PStaticText, Init (R, strings^.get(sSelectWhereToBegin)));
- Insert (Control);
- R.Assign (3, 3, 29, 4);
- Control := New (Dialogs.PStaticText, Init (R, strings^.get(sReformattingTheDocument)));
- Insert (Control);
- R.Assign (50, 5, 68, 6);
- Control := New (Dialogs.PLabel, Init (R, strings^.get(sReformatDocument), Control));
- Insert (Control);
- R.Assign (5, 5, 26, 7);
- Control := New (Dialogs.PRadioButtons, Init (R,
- NewSItem (labels^.get(slCurrentLine),
- NewSItem (labels^.get(slEntireDocument), Nil))));
- Control^.HelpCtx := hcDReformDoc;
- Insert (Control);
- R.Assign (4, 8, 14, 10);
- Control := New (Dialogs.PButton, Init (R,labels^.get(slOK), cmOK, Dialogs.bfDefault));
- Control^.HelpCtx := hcDOk;
- Insert (Control);
- R.Assign (17, 8, 27, 10);
- Control := New (Dialogs.PButton, Init (R, labels^.get(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, strings^.get(sRightMargin)));
- with D^ do
- begin
- Options := Options or ofCentered;
- R.Assign (5, 2, 13, 3);
- Control := New (Dialogs.PStaticText, Init (R, strings^.get(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, labels^.get(slOK), cmOK, Dialogs.bfDefault));
- Control^.HelpCtx := hcDOk;
- Insert (Control);
- R.Assign (14, 5, 24, 7);
- Control := New (Dialogs.PButton, Init (R, labels^.get(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, strings^.get(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, labels^.get(slOK), cmOK, Dialogs.bfDefault));
- Control^.HelpCtx := hcDOk;
- Insert (Control);
- R.Assign (42, 5, 52, 7);
- Control := New (Dialogs.PButton, Init (R, labels^.get(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(strings^.get(sOutOfMemory), nil, mfError + mfOkButton);
- edReadError:
- StdEditorDialog := MessageBox(strings^.get(sFileReadError), @Info, mfError + mfOkButton);
- edWriteError:
- StdEditorDialog := MessageBox(strings^.get(sFileWriteError), @Info, mfError + mfOkButton);
- edCreateError:
- StdEditorDialog := MessageBox(strings^.get(sFileCreateError), @Info, mfError + mfOkButton);
- edSaveModify:
- StdEditorDialog := MessageBox(strings^.get(sModified), @Info, mfInformation + mfYesNoCancel);
- edSaveUntitled:
- StdEditorDialog := MessageBox(strings^.get(sFileUntitled), nil, mfInformation + mfYesNoCancel);
- edSaveAs:
- StdEditorDialog := Application^.ExecuteDialog(New(PFileDialog, Init('*.*',
- labels^.get(slSaveFileAs), labels^.get(slName), fdOkButton, 101)), Info);
- edFind:
- StdEditorDialog := Application^.ExecuteDialog(CreateFindDialog, Info);
- edSearchFailed:
- StdEditorDialog := MessageBox(strings^.get(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, strings^.get(sReplaceThisOccurence),
- nil, mfYesNoCancel + mfInformation);
- end;
- edJumpToLine:
- StdEditorDialog := Application^.ExecuteDialog(JumpLineDialog, Info);
- edSetTabStops:
- StdEditorDialog := Application^.ExecuteDialog(TabStopDialog, Info);
- edPasteNotPossible:
- StdEditorDialog := MessageBox (strings^.get(sPasteNotPossible), nil, mfError + mfOkButton);
- edReformatDocument:
- StdEditorDialog := Application^.ExecuteDialog(ReformDocDialog, Info);
- edReformatNotAllowed:
- StdEditorDialog := MessageBox (strings^.get(sWordWrapOff), nil, mfError + mfOkButton);
- edReformNotPossible:
- StdEditorDialog := MessageBox (strings^.get(sReformatNotPossible), nil, mfError + mfOkButton);
- edReplaceNotPossible:
- StdEditorDialog := MessageBox (strings^.get(sReplaceNotPossible), nil, mfError + mfOkButton);
- edRightMargin:
- StdEditorDialog := Application^.ExecuteDialog(RightMarginDialog, Info);
- edWrapNotPossible:
- StdEditorDialog := MessageBox (strings^.get(sWordWrapNotPossible), nil, mfError + mfOKButton);
- else
- StdEditorDialog := MessageBox (strings^.get(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);
- { create uppercased string }
- s[0]:=chr(len);
- for x:=1to 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 := @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));
- 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
- if assigned(Buffer) then
- begin
- FreeMem (Buffer, BufSize);
- Buffer := nil;
- end;
- 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 := @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
- Buffer := MemAlloc (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
- SetBufSize := NewSize <= BufSize;
- 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 := @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
- if assigned(Buffer) then
- DisposeBuffer (Buffer);
- 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
- NewBuffer(Pointer(Buffer), 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
- if not SetBufferSize(pointer(Buffer), NewSize) then
- Exit;
- N := BufLen - CurPtr + DelCount;
- Move(Buffer^[BufSize - N], Buffer^[NewSize - N], N);
- if NewSize < BufSize then
- SetBufferSize(pointer(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 := strings^.get(sClipboard)
- else
- if Editor^.FileName = '' then
- GetTitle := strings^.get(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 }
|