home *** CD-ROM | disk | FTP | other *** search
- {$F+,O+,A+,B-,D-,E+,I-,L-,N-,R-,S-,V-}
-
- {***********************************************}
- {* BIGED.PAS 1.03a *}
- {* (11-Dec-90) *}
- {* Copyright (c) Steve Sneed 1990 *}
- {* All rights reserved *}
- {* Requires ObjectProfessional 1.03 or later *}
- {* from TurboPower Software *}
- {* *}
- {* Released to TurboPower Software for their *}
- {* use or release *}
- {***********************************************}
-
- {*
- BigEd is a collection of objects for implementing text editors with
- OPro. "Huh? OPro already has OpMemo/OpEditor!" you say, and you're
- right. But for some applications, OpEditor has one crippling
- limitation: it can only handle files of 64K or less in size. BigEd uses
- a linked list of lines approach to allow files as big as available
- memory. Because of the gross differences in how the text stream is
- stored and dealt with, BigEd is _not_ a derivitive of OpEditor, rather
- it is a similar-but-different set of objects.
-
- BigEd is modeled very closely on OpEditor as far as public methods and
- calling interface are concerned. Converting existing applications using
- OpEditor to BigEd is not completely painless, but it is pretty straight-
- forward. New applications implementing BigEd will closely mirror those
- using OpEditor. Some things look similar to OpEditor but function
- differently (for example, some of the flags constants in BigEd have the
- same names as those in OpEditor but are used for different things).
-
- BigEd is both more and less than OpEditor. Some things available in
- OpEditor are not here, either because they didn't really fit (the
- Initxxx routines that used an previously-allocated buffer, for example)
- or because I ran out of time before I got around to 'em. Streams
- support is noticable by its absense, printer support is limited to that
- provided by the Printer unit that comes with TP, etc. However, some
- things I've wanted for a while in OpEditor _are_ in BigEd, such as the
- ability to display the current line in a different color (ala QEdit), a
- "Clipboard" that can be copied or cut to and pasted from across multiple
- instances of BigEds or between files within a BigEd instance, and a few
- other geegaws.
-
- A project at work nessessitated this unit, although without some of its
- features as provided here. A friend wanted it badly, so I'm releasing
- this version now. It should be considered "rough"; I'm sure there's
- bugs still running loose, several routines could use a good dose of
- optimization, and error-checking is pretty lax in spots (I concentrated
- on out-of-memory and disk-I/O error reporting) but everything here works
- as far as I've tested. Bug reports, suggestions, complaints and
- requests should be addressed to:
-
- NOTE: This release is untested with the new Version 6.0 of TP and
- version 1.10 of Object Professional. It _should_ work, but until I
- receive OPro 1.10 I'm not promising.
-
- Steve Sneed
- CompuServe ID# 70007,3574
-
- Permission is hereby given to TurboPower Software to distribute this
- software as they see fit, either on a "Bonus disk" included with their
- products or by making it available on their section of the PCVENB Forum
- on CompuServe. Private parties may also distribute the software as long
- as no direct charge for such distribution is made.
-
-
- Version History:
- 1.03 - Original release. (*lots* of bugs!)
-
- 1.03a - Added support for ccScrollUp/ccScrollDn commands (per Kim's
- request); corrected missing compiler switches and directives in
- BEMAIN; fixed missing update of beModified flag in beTabOver and
- beDeleteWordRight; added EXECACCE.PAS unit with Kim's
- permission; modifed beBreakLine slightly to better conform to
- OpEditor's behavior when blocking ends at the end of a line and
- <CR> is pressed with the cursor beyond the last char in that
- line; fixed bugs in beInsertChar's and beTabOver's handling of
- blocking; tweaked parts of beUpdateContents for slightly better
- performance; fixed a bug in beReformatPara that caused a endless
- loop when reformatting the last paragraph in the file; added
- SetPrinter to match OpEditor's multiple printer port support and
- modified beWriteBlock to match; modified beReadBlock for better
- error checking; corrected logic errors in beLoad; fixed BEMAIN's
- Main proc to not die if the first file loaded had a read error;
- added block case-changing services; fixed a bug in
- beRestoreStreamState that caused the filename in the status line
- to not be updated properly when reloading a previously-loaded
- file; added a couple of missing "change options" methods and the
- "default" Init constructor; removed inadvertly-left-in comment
- marks that prevented BEMAIN's PromptNewFile proc from saving the
- file; other minor cleanups. (A mess of fixes, true! Shall we
- say, a "recommended upgrade"?)
-
- *}
-
- unit BigEd; {"big" editor objects}
-
- {$I OPDEFINE.INC}
-
- interface
-
- uses
- DOS,
- OpDos,
- OpInline,
- OpRoot,
- OpString,
- Lines,
- OpCrt,
- {$IFDEF UseMouse}
- OpMouse,
- {$ENDIF}
- OpCmd,
- {$IFDEF UseDrag}
- OpDrag,
- {$ENDIF}
- OpFrame,
- OpWindow;
-
- {$I BIGED.ICD} {keyboard definitions}
-
- const
- beInsert = $00000001; {True if in insert mode}
- beIndent = $00000002; {True if in auto-indent mode}
- beReadOnly = $00000004; {True if in read-only mode}
- beWordWrap = $00000008; {True if word wrap is on}
- beDeleteJoins = $00000010; {True if <Del> can join lines}
- beModified = $00000020; {True if edits have been made}
- beIndentIsPara = $00000040; {indent starts paragraph?}
- beMousePage = $00000080; {clicking on scroll bar scrolls by page}
- beMapCtrls = $00000200; {map control characters?}
- beMakeBackups = $00000400; {make backup files?}
- beReformatting = $00001000; {flag set while reformatting}
- beNewFile = $00002000; {new file loaded}
- beWrapAtLeft = $00008000; {wrap to prev line on <Left> at column 1}
- beStripHigh = $00010000; {strip hi bits when reading a file}
- beNoRepeatGlobal = $00020000; {flag to not repeat global search}
- beFastScrUpd = $00040000; {allow faster kbds/slow video cards} {!!}
- beBlockOK = $00080000; {set if block is currently OK} {!!}
- beShowMkrs = $00100000; {set to display highlighting is searches}
- beInProcess = $00800000; {internal flag set while in Process}
- beSmartTabs = $01000000; {smart tabs or fixed tabs?}
- beSearching = $02000000; {flag set while searching}
- beHighlightOn = $10000000; {if set the current line is highlighted} {!!}
- beHighlightBack = $20000000; {highlighting goes backwards?}
- beMarkersOn = $40000000; {text markers visible?}
- beBlockOn = $80000000; {block markers on?}
-
- {the commands in this set are disallowed in read-only mode}
- DisallowedInReadOnlyMode : set of Byte =
- [ccChar, ccCtrlChar, ccSelect, ccInsertLine, ccBack, ccDel, ccRestore,
- ccDelEol, ccDelLine, ccDelWord, ccIns, ccTab, ccIndent, ccWordWrap,
- ccReformatP, ccReformatG];
-
- {default options}
- DefBigEdOptions : LongInt = beInsert+beIndent+beMapCtrls+{beHighlightOn+}
- beMousePage+beMakeBackups+beSmartTabs;
- BadBigEdOptions : LongInt = beModified+beReformatting+beSearching+beBlockOK+
- beHighlightBack+beInProcess+beShowMkrs+beNewFile;
- DefEditorExt : ExtStr = ''; {default file extension}
- MaxBlockIndent = 10; {maximum indentation level for blocks}
- DefBlockIndent : Byte = 2; {default indentation level for blocks}
-
- MaxMarker = 3; {Maximum allowed position marker}
- MaxSearchLen = 30; {Maximum length of search string}
-
- {search option characters}
- MaxSearchOptions = 5;
- beBackward = 'B';
- beNoCase = 'U';
- beGlobal = 'G';
- beNoConfirm = 'N';
- beBlockOnly = 'L';
-
- {codes for yes-no functions}
- beNo = 0;
- beYes = 1;
- beQuit = 2;
- beAll = 3;
-
- beLpt : Integer = 1;
- beDefTabDelta : Integer = 8;
- beDefMaxLength : Integer = 254;
- beWordDelims : CharSet = [^I, ' '..'"', '.', ',', ':', ';', '?', '!',
- '*','(', ')', '[', ']', '{', '}', '<', '>',
- '+', '-', '/', '\', '''', '$', '=', '^', '#'];
-
- type
- ChArrType = Array[1..$FFF0] of Char;
- ChArrPtr = ^ChArrType;
- CharClass = (Blank, Alpha, Other);
- beSearchType = (bescNone, bescSearch, bescReplace);
-
- BigEdInfoProc = procedure(Msg : String);
- BigEdYesNoFunc = function(MsgCode : Word; Prompt : string;
- Default : Byte; QuitAndAll : Boolean) : Byte;
- BigEdEditFunc = function(MsgCode : Word; Prompt : string;
- ForceUp, TrimBlanks : Boolean;
- MaxLen : Byte; var S : string) : Boolean;
- BigEdGetFileFunc = function(MsgCode : Word; Prompt : string;
- ForceUp, TrimBlanks, Writing, MustExist : Boolean;
- MaxLen : Byte; DefExt : ExtStr;
- var S : string) : Boolean;
-
-
- MarkerRec = {used for marking a specific point in the stream}
- record
- Line : LinePtr;
- LNum : Integer;
- Col : Integer;
- end;
- MarkerArray = Array[0..MaxMarker] of MarkerRec;
-
- StreamStateRec =
- record
- SaveCurTopIdx : Integer;
- SaveCurLineOfs : Integer;
- SaveXOfs : Integer;
- SaveCOfs : Integer;
- SaveFlags : LongInt;
- SaveBkTop : MarkerRec;
- SaveBkBot : MarkerRec;
- SaveMarkers : MarkerArray;
- end;
-
- BigEditorPtr = ^BigEditor;
- BigEdStatusProc = procedure(BEP : BigEditorPtr);
- BigEditor = {our overall editor object}
- object(CommandWindow)
- EList : LineList; {current doublelist of lines}
- TmpList : LineList; {temp list for blocking}
- CurTop : LinePtr; {current line at top of the window}
- CurLine : LinePtr; {current line being edited}
- CurTopIdx : Integer; {line # of CurTop}
- CurLineOfs : Integer; {# of lines CurLine is down from CurTop}
- XOfs : Integer; {for horizontal positioning of window}
- COfs : Integer; {for horizontal positioning of cursor}
- TmpOfs : Integer; {temp placeholder for positioning}
-
- Current : String; {current string of text}
- Tmp : String; {temp holding string}
-
- Margin : Integer; {right margin}
- WinWidth : Integer; {width of inner window}
- WinHeight : Integer; {height of inner window}
- Path : PathStr; {name of current file}
- beDefExt : ExtStr; {default filename extension}
-
- beSearchLine : LinePtr; {Current line of search}
- beSearchSt : string[MaxSearchLen]; {String to search for}
- beReplaceSt : string[MaxSearchLen]; {String to replace it with}
- beOptionSt : string[MaxSearchOptions]; {Search options}
- beLastSearch : beSearchType; {Type of last search operation}
- beReplacements : Integer; {Number of replacements made}
-
- beBlockColor : Byte; {attributes for blocks, markers}
- beBlockMono : Byte; {and highlighted current line}
- beMarkerColor : Byte;
- beMarkerMono : Byte;
- beHighlightColor : Byte;
- beHighlightMono : Byte;
- beCtrlColor : Byte;
- beCtrlMono : Byte;
- ColorsChanged : Boolean;
-
- beStatusProc : BigEdStatusProc; {procedure for status}
- beInfoProc : BigEdInfoProc; {procedure for information}
- beEditFunc : BigEdEditFunc; {function to edit a string}
- beGetFile : BigEdGetFileFunc; {function to get a filename}
- beYesNoFunc : BigEdYesNoFunc; {function to get a Yes/No response}
-
- beOptions : LongInt; {our current options flags}
- beForceRedraw : Boolean; {True if we need to redraw the whole window}
- beTabDelta : Integer; {size of tabs}
- beSaveSize : Integer; {saved size of list}
-
- BkTop : MarkerRec; {current marked block top line/col}
- BkBot : MarkerRec; {current marked block bottom line/col}
- SBkTop : MarkerRec; {last marked block top line/col}
- SBkBot : MarkerRec; {last marked block bottom line/col}
- CurPos : MarkerRec; {saved current position in stream}
- Markers : MarkerArray; {set of markerrecs for text markers}
- MarkerFlags : Word; {flag word for set markers}
-
- constructor Init(X1, Y1, X2, Y2 : Byte);
- {-init a BigEditor with default options, allocate new edit list}
- constructor InitCustom(X1, Y1, X2, Y2 : Byte;
- var Colors : ColorSet;
- WinOptions : LongInt;
- EditorOpts : LongInt);
- {-init a BigEditor with custom options, allocate new edit list}
- destructor Done; virtual;
- {-dispose a BigEditor}
- function beOptionsAreOn(L : LongInt) : Boolean;
- {-True if all selected options are on}
- procedure beOptionsOn(L : LongInt);
- {-turn on selected options}
- procedure beOptionsOff(L : LongInt);
- {-turn off selected options}
- {...}
- procedure beSetInfoProc(IP : BigEdInfoProc);
- {-set the procedure for beInfo}
- procedure beSetStatusProc(SP : BigEdStatusProc);
- {-set the procedure for beStatus}
- procedure beSetEditProc(EF : BigEdEditFunc);
- {-Set edit function}
- procedure beSetGetFileProc(GFF : BigEdGetFileFunc);
- {-Set get file function}
- procedure beSetYesNoProc(YNF : BigEdYesNoFunc);
- {-Set yes-no function}
- procedure beSetTextAttr(Color, Mono : Byte);
- {-set attributes for normal text}
- procedure beSetBlockAttr(Color, Mono : Byte);
- {-Set attributes for marked blocks}
- procedure beSetMarkerAttr(Color, Mono : Byte);
- {-Set attributes for text markers and found text}
- procedure beSetHighlightAttr(Color, Mono : Byte);
- {-Set attributes for highlighted current line}
- procedure beSetCtrlAttr(Color, Mono : Byte);
- {-Set attributes for mapped control characters}
- procedure SetBlockIndent(Indent : Byte);
- {-Set block indentation level}
- procedure SetDefaultExtension(DefExt : ExtStr);
- {-Default extension to use when prompting for filenames}
- procedure SetPrinter(LptNum : Integer);
- {-Set printer (1-3)}
- {...}
-
- {**methods that exist to be overridden**}
- procedure beInformation(MsgCode : Word; Msg : String); virtual;
- {-display info}
- function beGetString(MsgCode : Word; Prompt : string;
- ForceUp, TrimBlanks : Boolean;
- MaxLen : Byte; var S : string) : Boolean; virtual;
- {-get an input string}
- function beGetNumber(MsgCode : Word; Prompt : string;
- var L : LongInt; LLo, LHi : LongInt) : Boolean; virtual;
- {-get an input number}
- function beYesNo(MsgCode : Word; Prompt : string; Default : Byte;
- QuitAndAll : Boolean) : Byte; virtual;
- {-get a Yes/No response}
- function beGetFileName(MsgCode : Word; Prompt : string;
- var FName : PathStr;
- Writing : Boolean;
- MustExist : Boolean) : Boolean; virtual;
- {-get a filename}
- procedure NewFilePrompted; virtual;
- {-prompt for a new file and load it}
- procedure UpdateContents; virtual;
- {-object-level screen update}
- procedure ProcessSelf; virtual;
- {-main process loop}
-
- {*** internal methods ***}
- procedure beResetMarkers(ClearTextMarkers : Boolean);
- procedure beResetLineList;
- procedure beNewLineList;
- procedure beSaveThisPosition;
- procedure beCursorRight(Count : Integer);
- procedure beCursorLeft(Count : Integer);
- procedure beCursorHome;
- procedure beCursorEOL;
- procedure beTopOfFile;
- procedure beEndOfFile;
- procedure beScrollUp(Count : Integer);
- procedure beScrollDown(Count : Integer);
- procedure beLineUp(Count : Integer);
- procedure beLineDown(Count : Integer);
- procedure beJumpToLine(I : Integer);
- procedure beJumpToLinePtr(P : LinePtr);
- procedure beResetSplit;
- procedure beRealign;
- procedure beRealignDown;
- function beOfsWhite(P : LinePtr) : Byte;
- procedure beClearBlocking;
- procedure beConnectMarks;
- procedure beCheckBlock;
- function beLineInBlock(P : LinePtr) : Boolean;
- procedure beSetBkTop;
- procedure beSetBkBot;
- function beStoreBlock(var ToList : LineList) : Boolean;
- procedure beInsertBlockAtCursor(var FromList : LineList);
- procedure beCopyBlock;
- procedure beMoveBlock;
- procedure beReadBlock;
- procedure beWriteBlock(ToPrn : Boolean);
- procedure beDeleteBlock;
- procedure beIndentBlock(AddSP : Boolean);
- procedure beBlockWord;
- procedure beChangeCaseBlock(Cmd : Byte);
- procedure beCopyToClipboard;
- procedure beCutToClipboard;
- procedure bePasteFromClipboard;
- procedure beDeleteLinePrim(P : LinePtr);
- procedure beCharsInserted(LP : LinePtr; Count : Integer);
- procedure beLineDeleted(P : LinePtr);
- procedure beBreakLine(At : Integer);
- procedure beWrapLine;
- procedure beJoinLines(LP : LinePtr);
- procedure beTabOver;
- procedure beInsertChar(C : Char);
- procedure beNewLine(MoveDown : Boolean);
- procedure beBackspace;
- procedure beDeleteCharAtCursor;
- procedure beWordLeft;
- procedure beWordRight;
- procedure beDeleteWordRight;
- procedure beDeleteToEndOfLine;
- procedure beCenterLine;
- procedure beSaveStreamState(var S : StreamStateRec;
- SaveBlocking : Boolean);
- procedure beRestoreStreamState(var S : StreamStateRec;
- RestoreBlocking : Boolean);
- procedure beTextSearch(Prompt : Boolean; SearchType : beSearchType);
- procedure beReformatPara;
- procedure beReformatGlobally;
-
- function beLoad(FN : String; MustExist : Boolean) : Boolean;
- function beStore(FN : String) : Boolean;
- {$IFDEF UseScrollBars}
- procedure beUpdateScrollBars;
- {$ENDIF}
- procedure beUpdateContents;
- procedure ProcessCtrlChar;
- {$IFDEF UseMouse}
- function beProcessMouseCommand : Boolean;
- {$ENDIF}
- procedure beSetRightMarginPrompted;
- procedure beSetBlockIndentPrompted;
- procedure beSetTabSizePrompted;
- end;
-
-
- var
- Clipboard : LineList;
-
- {$IFDEF UseDrag}
- BigEdCommands : DragProcessor;
- {$ELSE}
- BigEdCommands : CommandProcessor;
- {$ENDIF}
-
- implementation
-
- {globals used in TextSearches}
- var
- NoCase : Boolean;
- Backwards : Boolean;
- NoConfirm : Boolean;
- BlockOnly : Boolean;
- Global : Boolean;
-
- function Min(A,B : Integer) : Integer;
- begin
- if A < B then
- Min := A
- else
- Min := B;
- end;
-
- procedure StripHiBits(var S : String);
- var B : Byte;
- begin
- for B := 1 to Length(S) do
- S[b] := Char(Byte(S[b]) and $7F);
- end;
-
- function GetClass(Ch : Char) : CharClass;
- begin
- if Ch = ' ' then
- GetClass := Blank
- else if Ch in beWordDelims then
- GetClass := Other
- else
- GetClass := Alpha;
- end;
-
- procedure IncPtr(var LP : LinePtr; Count : Integer);
- var I : Integer;
- begin
- for I := 1 to Count do
- if LP <> NIL then
- LP := LinePtr(LP^.dlNext);
- end;
-
- procedure DecPtr(var LP : LinePtr; Count : Integer);
- var I : Integer;
- begin
- for I := 1 to Count do
- if LP <> NIL then
- LP := LinePtr(LP^.dlPrev);
- end;
-
- {---------------------------------------------------------------------------}
-
- constructor BigEditor.Init(X1, Y1, X2, Y2 : Byte);
- begin
- if NOT BigEditor.InitCustom(X1, Y1, X2, Y2, DefaultColorSet,
- DefWindowOptions, DefBigEdOptions) then
- Fail;
- end;
-
- constructor BigEditor.InitCustom(X1, Y1, X2, Y2 : Byte;
- var Colors : ColorSet;
- WinOptions : LongInt;
- EditorOpts : LongInt);
- begin
- if NOT CommandWindow.InitCustom(X1, Y1, X2, Y2, Colors, WinOptions,
- BigEdCommands, ucNone) then begin
- WriteLn('Error ',InitStatus,' initing CommandWindow');
- Fail;
- end;
-
- EList.Init;
- TmpList.Init;
-
- beNewLineList;
-
- beSearchLine := NIL;
- beSearchSt := '';
- beReplaceSt := '';
- beOptionSt := '';
- WinWidth := Width;
- Margin := Width - 2;
- beForceRedraw := True;
- beSaveSize := $7FFF;
- beOptions := EditorOpts;
- beTabDelta := beDefTabDelta;
- Path := '';
- beDefExt := DefEditorExt;
-
- with Colors do begin
- beBlockColor := BlockColor;
- beBlockMono := BlockMono;
- beMarkerColor := MarkerColor;
- beMarkerMono := MarkerMono;
- beHighlightColor := HighlightColor;
- beHighlightMono := HighlightMono;
- beCtrlColor := CtrlColor;
- beCtrlMono := CtrlMono;
- ColorsChanged := True;
- end;
-
- @beStatusProc := NIL;
- @beInfoProc := NIL;
- @beEditFunc := NIL;
- @beGetFile := NIL;
- @beYesNoFunc := NIL;
- end;
-
-
- destructor BigEditor.Done;
- begin
- TmpList.Done;
- EList.Done;
- CommandWindow.Done;
- end;
-
- function BigEditor.beOptionsAreOn(L : LongInt) : Boolean;
- {-True if all selected options are on}
- begin
- beOptionsAreOn := (LongFlagIsSet(beOptions,L));
- end;
-
- procedure BigEditor.beOptionsOn(L : LongInt);
- {-turn on one or more options}
- begin
- SetLongFlag(beOptions,L and not BadBigEdOptions);
- end;
-
- procedure BigEditor.beOptionsOff(L : LongInt);
- {-turn off one or more options}
- begin
- ClearLongFlag(beOptions,L or BadBigEdOptions);
- end;
-
- procedure BigEditor.beSetInfoProc(IP : BigEdInfoProc);
- {-assign the "information" procedure}
- begin
- beInfoProc := IP;
- end;
-
- procedure BigEditor.beSetStatusProc(SP : BigEdStatusProc);
- {-assign the "status" procedure}
- begin
- beStatusProc := SP;
- end;
-
- procedure BigEditor.beSetEditProc(EF : BigEdEditFunc);
- {-assign the line editor service}
- begin
- beEditFunc := EF;
- end;
-
- procedure BigEditor.beSetGetFileProc(GFF : BigEdGetFileFunc);
- {-assign the service to get a file name}
- begin
- beGetFile := GFF;
- end;
-
- procedure BigEditor.beSetYesNoProc(YNF : BigEdYesNoFunc);
- {-assign the service to get a yes/no response}
- begin
- beYesNoFunc := YNF;
- end;
-
- procedure BigEditor.beSetTextAttr(Color, Mono : Byte);
- {-change the default attribute for marked blocks}
- begin
- wTextColor := Color;
- wTextMono := MapMono(Color, Mono);
- ColorsChanged := True;
- end;
-
- procedure BigEditor.beSetBlockAttr(Color, Mono : Byte);
- {-change the default attribute for marked blocks}
- begin
- beBlockColor := Color;
- beBlockMono := MapMono(Color, Mono);
- ColorsChanged := True;
- end;
-
- procedure BigEditor.beSetMarkerAttr(Color, Mono : Byte);
- {-change the default attribute for text markers}
- begin
- beMarkerColor := Color;
- beMarkerMono := MapMono(Color, Mono);
- ColorsChanged := True;
- end;
-
- procedure BigEditor.beSetHighlightAttr(Color, Mono : Byte);
- {-change the default attribute for highlighting the current line}
- begin
- beHighlightColor := Color;
- beHighlightMono := MapMono(Color, Mono);
- ColorsChanged := True;
- end;
-
- procedure BigEditor.beSetCtrlAttr(Color, Mono : Byte);
- {-change the default attribute for mapped control characters}
- begin
- beCtrlColor := Color;
- beCtrlMono := MapMono(Color, Mono);
- ColorsChanged := True;
- end;
-
- procedure BigEditor.beInformation(MsgCode: Word; Msg : String);
- {-overridable method for info}
- begin
- if @beInfoProc <> nil then
- beInfoProc(Msg);
- end;
-
- function BigEditor.beGetString(MsgCode : Word; Prompt : string;
- ForceUp, TrimBlanks : Boolean;
- MaxLen : Byte; var S : string) : Boolean;
- {-overridable method for GetString}
- begin
- if cwCmdPtr^.CommandStringPending then begin
- S := cwCmdPtr^.GetCommandString;
- beGetString := True;
- end
- else if @beEditFunc = nil then
- beGetString := False
- else
- beGetString := beEditFunc(MsgCode, Prompt, ForceUp, TrimBlanks, MaxLen, S);
- end;
-
- function BigEditor.beGetNumber(MsgCode : Word; Prompt : string;
- var L : LongInt; LLo, LHi : LongInt) : Boolean;
- {-overridable method for GetNumber}
- var
- OK : Boolean;
- St : String[10];
- LT : LongInt;
- begin
- beGetNumber := False;
- LT := L;
- St := Long2Str(LT);
-
- repeat
- if (not beGetString(MsgCode, Prompt, False, True, 10, St)) or (St = '') then
- Exit;
- OK := Str2Long(St, LT) and (LT >= LLo) and (LT <= LHi);
- if not OK then
- GotError(epWarning+ecInvalidNumber, emInvalidNumber);
- until OK;
-
- L := LT;
- beGetNumber := True;
- end;
-
- function BigEditor.beYesNo(MsgCode : Word; Prompt : string; Default : Byte;
- QuitAndAll : Boolean) : Byte;
- {-overridable method for getting a yes/no response}
- var
- S : string[1];
- begin
- if cwCmdPtr^.CommandStringPending then begin
- S := cwCmdPtr^.GetCommandString;
- beYesNo := Default;
- if S <> '' then
- case S[1] of
- 'N' : beYesNo := beNo;
- 'Y' : beYesNo := beYes;
- 'Q' : beYesNo := beQuit;
- 'A' : beYesNo := beAll;
- end;
- end
- else if @beYesNoFunc = nil then
- beYesNo := beQuit
- else
- beYesNo := beYesNoFunc(MsgCode, Prompt, Default, QuitAndAll);
- end;
-
- function BigEditor.beGetFileName(MsgCode : Word; Prompt : string;
- var FName : PathStr;
- Writing : Boolean;
- MustExist : Boolean) : Boolean;
- {-overridable method for getting a filename}
- const
- MaxLen = SizeOf(PathStr)-1;
- begin
- if cwCmdPtr^.CommandStringPending then begin
- FName := DefaultExtension(cwCmdPtr^.GetCommandString, beDefExt);
- beGetFileName := (FName <> '');
- end
- else if @beGetFile = nil then
- beGetFileName := False
- else if beGetFile(MsgCode, Prompt, True, True, Writing, MustExist,
- MaxLen, beDefExt, FName) then begin
- {FName := DefaultExtension(FName, beDefExt);} {!!.01}
- beGetFileName := (FName <> '');
- end
- else
- beGetFileName := False;
- end;
-
- {---------------------------------------------------------------------------}
-
- procedure BigEditor.beResetMarkers(ClearTextMarkers : Boolean);
- begin
- FillChar(BkTop,SizeOf(BkTop),0);
- BkBot := BkTop;
- if ClearTextMarkers then begin
- FillChar(Markers,SizeOf(Markers),0);
- MarkerFlags := 0;
- end;
- end;
-
- procedure BigEditor.beResetLineList;
- begin
- with EList do begin
- CurTop := LinePtr(dlHead);
- CurLine := CurTop;
- CurTopIdx := 1;
- CurLineOfs := 0;
- COfs := 1;
- XOfs := 0;
- Current := CurTop^.lnReturn;
- beResetMarkers(True);
- beSaveThisPosition;
- end;
- end;
-
- procedure BigEditor.beNewLineList;
- var L : LinePtr;
- begin
- New(L,Init(''));
- EList.Clean;
- EList.Append(L);
- beResetLineList;
- end;
-
- procedure BigEditor.beSaveThisPosition;
- begin
- with CurPos do begin
- Line := CurLine;
- LNum := CurTopIdx+CurLineOfs;
- Col := COfs+XOfs;
- end;
- end;
-
- procedure BigEditor.beCursorRight(Count : Integer);
- var N : Integer;
- begin
- for N := 1 to Count do begin
- if XOfs + Width >= 254 then
- exit;
- if COfs < Width then
- Inc(COfs)
- else begin
- Inc(XOfs);
- beForceRedraw := True;
- end;
- end;
- end;
-
- procedure BigEditor.beCursorLeft(Count : Integer);
- var N : Integer;
- begin
- for N := 1 to Count do
- if COfs > 1 then
- Dec(COfs)
- else if XOfs > 0 then begin
- Dec(XOfs);
- beForceRedraw := True;
- end
- else if (Count = 1) and (beOptionsAreOn(beWrapAtLeft)) then begin
- beLineUp(1);
- beCursorEOL;
- end;
- end;
-
- procedure BigEditor.beCursorHome;
- begin
- COfs := 1;
- if XOfs > 0 then
- beForceRedraw := True;
- XOfs := 0;
- end;
-
- procedure BigEditor.beCursorEOL;
- var N : Integer;
- begin
- beCursorHome;
- beCursorRight(CurLine^.lnLen);
- end;
-
- procedure BigEditor.beTopOfFile;
- begin
- CurTop := LinePtr(EList.dlHead);
- CurLine := CurTop;
- CurTopIdx := 1;
- CurLineOfs := 0;
- COfs := 1;
- XOfs := 0;
- beForceRedraw := True;
- end;
-
- procedure BigEditor.beEndOfFile;
- var
- N : Integer;
- begin
- CurTop := LinePtr(EList.dlTail);
- CurLine := CurTop;
- CurTopIdx := EList.Size;
- CurLineOfs := 0;
- for N := 1 to Height-1 do
- if CurTop^.dlPrev <> nil then begin
- CurTop := LinePtr(CurTop^.dlPrev);
- Dec(CurTopIdx);
- Inc(CurLineOfs);
- end;
- beForceRedraw := True;
- end;
-
- procedure BigEditor.beScrollUp(Count : Integer);
- var
- N : Integer;
- begin
- for N := 1 to Count do
- if CurTop^.dlPrev <> nil then begin
- CurTop := LinePtr(CurTop^.dlPrev);
- Dec(CurTopIdx);
- CurLine := LinePtr(CurLine^.dlPrev);
- end;
- beForceRedraw := True;
- end;
-
- procedure BigEditor.beScrollDown(Count : Integer);
- var
- N : Integer;
- begin
- for N := 1 to Count do
- if CurTop^.dlNext <> nil then begin
- CurTop := LinePtr(CurTop^.dlNext);
- Inc(CurTopIdx);
- if CurLine^.dlNext <> nil then
- CurLine := LinePtr(CurLine^.dlNext)
- else if CurLineOfs > 0 then
- Dec(CurLineOfs)
- else
- CurLine := CurTop;
- end;
- beForceRedraw := True;
- end;
-
- procedure BigEditor.beLineUp(Count : Integer);
- var
- N : Integer;
- begin
- N := 0;
- while N < Count do
- if CurLineOfs = 0 then begin
- beScrollUp(Count - N);
- exit;
- end
- else begin
- CurLine := LinePtr(CurLine^.dlPrev);
- Dec(CurLineOfs);
- Inc(N);
- end;
- end;
-
- procedure BigEditor.beLineDown(Count : Integer);
- var
- N : Integer;
- begin
- N := 0;
- while N < Count do
- if CurLineOfs = (Height - 1) then begin
- beScrollDown(Count - N);
- exit;
- end
- else begin
- if CurLine^.dlNext <> nil then begin
- CurLine := LinePtr(CurLine^.dlNext);
- Inc(CurLineOfs);
- end;
- Inc(N);
- end;
- end;
-
- procedure BigEditor.beJumpToLine(I : Integer);
- begin
- CurTop := LinePtr(EList.Nth(I));
- CurTopIdx := I;
- CurLine := CurTop;
- CurLineOfs := 0;
- while (CurLineOfs < Height div 2) and (CurTop^.dlPrev <> nil) do begin
- CurTop := LinePtr(CurTop^.dlPrev);
- Dec(CurTopIdx);
- Inc(CurLineOfs);
- end;
- end;
-
- procedure BigEditor.beJumpToLinePtr(P : LinePtr);
- begin
- CurTop := P;
- CurTopIdx := EList.Num(P);
- CurLine := CurTop;
- CurLineOfs := 0;
- while (CurLineOfs < Height div 2) and (CurTop^.dlPrev <> nil) do begin
- CurTop := LinePtr(CurTop^.dlPrev);
- Dec(CurTopIdx);
- Inc(CurLineOfs);
- end;
- end;
-
- {$I BIGED.IN1}
-
- function BigEditor.beLoad(FN : String; MustExist : Boolean) : Boolean;
- {-load a text stream for editing}
- label ExitPoint;
- var F : Text;
- P : LinePtr;
- A : String;
- R : ChArrPtr;
- RSiz : Integer;
- L : LongInt;
- begin
- beNewLineList;
- with EList do begin
- {if possible, make a TextBuf to speed things up}
- L := MaxAvail;
- if L >= $4000 then
- RSiz := $4000
- else if L > 4096 then
- RSiz := Word(L)
- else
- RSiz := 0;
- if RSiz > 0 then
- GetMem(R,RSiz);
- beLoad := False;
-
- {load the file}
- SetLongFlag(beOptions,beNewFile);
- Assign(F,FN);
- if RSiz > 0 then SetTextBuf(F,R^,RSiz);
- Reset(F);
- if (IOResult = 0) then begin
- beInformation(0,'Loading '+FN+'...');
- while NOT EOF(F) do begin
- ReadLn(F,A);
- if IOResult <> 0 then begin
- Close(F); if IOResult = 0 then ;
- GotError(epNonFatal+ecDeviceRead,'Error reading '+FN);
- goto ExitPoint;
- end;
- A := TrimTrail(A);
- if beOptionsAreOn(beStripHigh) then
- StripHiBits(A);
- New(P,Init(A));
- if P = NIL then begin
- GotError(epFatal+ecOutofMemory,'Out of memory');
- goto ExitPoint;
- end;
- PlaceBefore(P,Tail);
- end;
- Close(F); if IOResult = 0 then ;
- end
- else if MustExist then begin
- GotError(epNonFatal+ecFileNotFound,FN+' not found');
- goto ExitPoint;
- end;
- Path := StUpCase(FN);
- beLoad := True;
- end;
- beResetLineList;
- ExitPoint:
- if RSiz > 0 then
- FreeMem(R,RSiz);
- beInformation(0,'');
- beForceRedraw := True;
- end;
-
- function BigEditor.beStore(FN : String) : Boolean;
- {-save the current stream to a file}
- label Skip;
- var F : Text;
- P : LinePtr;
- B : Boolean;
- D : Boolean;
- R : ChArrPtr;
- RSiz : Integer;
- L : LongInt;
-
- function MakeABackup : Boolean;
- {-make a backup copy of the file}
- var G : File;
- begin
- MakeABackup := False;
- if ExistFile(ForceExtension(FN,'BAK')) then begin
- Assign(G,ForceExtension(FN,'BAK'));
- System.Erase(G);
- if IOResult <> 0 then exit;
- end;
- Assign(G,FN);
- Rename(G,ForceExtension(FN,'BAK'));
- if IOResult <> 0 then exit;
- MakeABackup := True;
- end;
-
- begin
- with EList do begin
- beStore := False;
- if LongFlagIsSet(beOptions,beMakeBackups) then
- if NOT MakeABackUp then exit;
-
- {if possible, make a TextBuf to speed things up}
- L := MaxAvail;
- if L >= $4000 then
- RSiz := $4000
- else if L > 4096 then
- RSiz := Word(L)
- else
- RSiz := 0;
-
- Assign(F,FN);
- if RSiz > 0 then begin
- GetMem(R,RSiz);
- SetTextBuf(F,R^,RSiz);
- end;
- Rewrite(F);
- if IOResult <> 0 then
- goto Skip;
-
- beInformation(0,'Saving '+FN+'...');
- P := LinePtr(dlHead);
- while (P <> NIL) and (P <> LinePtr(Tail)) do begin
- WriteLn(F,P^.lnReturn);
- if IOResult <> 0 then goto Skip;
- P := LinePtr(P^.dlNext);
- end;
- beStore := True;
- Skip:
- Close(F); if IOResult = 0 then ;
- if RSiz > 0 then
- FreeMem(R,RSiz);
- beInformation(0,'');
- end;
- end;
-
- {$IFDEF UseScrollBars}
- procedure BigEditor.beUpdateScrollBars;
- {-Update horizontal and vertical scroll bars}
- begin
- if EList.Size <> beSaveSize then begin
- ChangeAllScrollBars(0, (254-Width), 1, EList.Size);
- beSaveSize := EList.Size;
- end;
- DrawAllSliders(XOfs, CurTopIdx+CurLineOfs);
- end;
- {$ENDIF}
-
- procedure BigEditor.beUpdateContents;
- {-low-level screen update routine}
- label Skip;
- const
- TAttr : Byte = $07;
- HAttr : Byte = $0F;
- BAttr : Byte = $70;
- MAttr : Byte = $09;
- CAttr : Byte = $70;
- var
- P : LinePtr;
- N : Integer;
- MY : Byte;
-
- procedure DrawLine(P : LinePtr; Y : Byte);
- {-draw one line of the window, accounting for all possible qwerks}
- var I : Integer;
- St : String;
- As : String;
- S : String[MaxSearchLen];
- L : Byte;
- J,K : Integer;
- M : Boolean;
- MB : Boolean;
- begin
- with EList do begin
- L := P^.lnLen;
-
- {set up the basic line}
- FillChar(St[1],WinWidth,' ');
- St[0] := Chr(WinWidth);
- if (P <> NIL) and (L > XOfs) then
- MoveFast(P^.St^[XOfs+1],St[1],Min(L-XOfs,Width));
- if (P = CurLine) and (LongFlagIsSet(beOptions,beHighlightOn)) then
- FillChar(As[1],WinWidth,Chr(HAttr))
- else
- FillChar(As[1],WinWidth,Chr(TAttr));
- As[0] := Chr(WinWidth);
-
- if P <> NIL then begin
- {handle blocking}
- if (P^.lnFlagsAreOn(IsBlocked)) and
- (LongFlagIsSet(beOptions,beBlockOn)) then begin
- if P = BkTop.Line then begin
- K := 0; J := 1;
- if P = BkBot.Line then begin
- if BkTop.Col <= XOfs then
- J := 1
- else
- J := BkTop.Col - XOfs;
- if LongInt((BkBot.Col + 1) - J) < 1 then
- K := 0
- else if (BkBot.Col + 1) - J > WinWidth then
- K := WinWidth
- else
- K := (BkBot.Col + 1) - J;
- end
- else if BkTop.Col <= XOfs then begin
- J := 1;
- K := WinWidth;
- end
- else if BkTop.Col > WinWidth then
- K := 0
- else begin
- J := BkTop.Col - XOfs;
- K := WinWidth - J + 1;
- end;
- if K > 0 then
- FillChar(As[J],K,Chr(BAttr));
- end
- else if P = BkBot.Line then begin
- if BkBot.Col > XOfs+WinWidth then
- FillChar(As[1],WinWidth,Chr(BAttr))
- else if BkBot.Col > XOfs then
- FillChar(As[1],BkBot.Col-XOfs,Chr(BAttr));
- end
- else
- FillChar(As[1],WinWidth,Chr(BAttr));
- end;
-
- {handle markers}
- if (LongFlagIsSet(beOptions,beMarkersOn)) then
- for I := 0 to MaxMarker do
- if P = Markers[i].Line then
- if (Markers[i].Col >= XOfs) and (Markers[i].Col <= (XOfs+WinWidth)) then begin
- St[Markers[i].Col-XOfs+1] := Chr(Ord('0')+i);
- As[Markers[i].Col-XOfs+1] := Chr(MAttr);
- end;
-
- if (P = beSearchLine) and
- (beOptionsAreOn(beSearching)) and
- (beOptionsAreOn(beShowMkrs)) then begin
- if LongFlagIsSet(beOptions,beHighlightBack) then
- FillChar(As[COfs-Byte(beSearchSt[0])],Byte(beSearchSt[0]),MAttr)
- else
- FillChar(As[COfs],Byte(beSearchSt[0]),MAttr);
- end;
-
- {map controls}
- if LongFlagIsSet(beOptions,beMapCtrls) then
- for I := 1 to Length(St) do
- if St[i] < #32 then begin
- Inc(Byte(St[i]),64);
- As[i] := Char(CAttr);
- end;
- end;
-
- {$IFDEF UseMouse}
- if MY = (Y+wYL) then begin
- HideMousePrim(M);
- MB := True;
- end
- else MB := False;
- {$ENDIF}
- FastWriteAttr(St, Y+wYL, wXL, As);
- {$IFDEF UseMouse}
- if MB then ShowMousePrim(M);
- {$ENDIF}
- end;
- end;
-
- begin
- {see if we need to update the colors}
- if ColorsChanged then begin
- TAttr := ColorMono(wTextColor,wTextMono);
- HAttr := ColorMono(beHighlightColor,beHighlightMono);
- BAttr := ColorMono(beBlockColor,beBlockMono);
- CAttr := ColorMono(beCtrlColor,beCtrlMono);
- MAttr := ColorMono(beMarkerColor,beMarkerMono);
- ColorsChanged := False;
- end;
-
- with EList do begin
- {$IFDEF UseMouse}
- MY := MouseWhereY;
- {$ENDIF}
- WinHeight := Height - 1;
- WinWidth := Width;
-
- if beForceRedraw then begin
- P := CurTop;
- for N := 0 to WinHeight do begin
- DrawLine(P,N);
- if cwCmdPtr^.cpKeyPressed then
- goto Skip;
- if P <> NIL then
- P := LinePtr(P^.dlNext);
- end;
- {don't reset beForceRedraw until here, so if we drop out before }
- {redrawing the whole screen we'll be sure to attempt it next time}
- beForceRedraw := False;
- end
- else begin
- DrawLine(CurLine,CurLineOfs);
- if LongFlagIsSet(beOptions,beHighlightOn) then begin
- {keep highlighting current}
- if CurLineOfs > 0 then
- DrawLine(LinePtr(CurLine^.dlPrev),CurLineOfs-1);
- if CurLineOfs < (Height-1) then
- DrawLine(LinePtr(CurLine^.dlNext),CurLineOfs+1);
- end;
- end;
- Skip:
- {position and fixup cursor, scrollbars, status}
- {$IFDEF UseScrollBars}
- beUpdateScrollBars;
- {$ENDIF}
- GoToXYAbs(Pred(wXL)+COfs,wYL+CurLineOfs);
- if LongFlagIsSet(beOptions,beInsert) then FatCursor else NormalCursor;
- {make sure status line is updated}
- beStatusProc(@Self);
- end;
- end;
-
- procedure BigEditor.UpdateContents;
- {-object-level redraw}
- begin
- CommandWindow.UpdateContents;
- beUpdateContents;
- end;
-
- procedure BigEditor.ProcessCtrlChar;
- {-process ^P request}
- var Ch : Char absolute cwKey;
- begin
- if ColorMono(wTextColor, wTextMono) = ColorMono(beCtrlColor, beCtrlMono) then
- cwCmd := ccNone
- else begin
- BlockCursor;
- cwKey := cwCmdPtr^.cpGetKey;
- case Ch of
- ^M : cwCmd := ccSelect;
- ^J, ^Z : cwCmd := ccNone;
- else cwCmd := ccChar;
- end;
- if LongFlagIsSet(beOptions,beInsert) then FatCursor else NormalCursor;
- end;
- end;
-
- {$IFDEF UseMouse}
- function BigEditor.beProcessMouseCommand : Boolean;
- {-Process ccMouseSel command. Returns True to return control to user.}
- var
- L : LongInt;
- FramePos : FramePosType;
- HotCode : Byte;
-
- procedure CurLineToNewOfs;
- var P : LinePtr;
- W : Integer;
- begin
- CurLine := CurTop;
- W := 0;
- while W <> CurLineOfs do begin
- CurLine := LinePtr(EList.Next(CurLine));
- Inc(W);
- end;
- end;
-
- procedure MouseSelect;
- {-Move cursor to position of mouse}
- var
- CurRow, TargetLine : Integer;
- TargetRow, TargetCol, I : Integer;
- begin
- CurLineOfs := MouseKeyWordY+MouseYLo-wYL;
- COfs := MouseKeyWordX+MouseXLo-(wXL-1);
- CurLineToNewOfs;
- beForceRedraw := True;
- end;
-
- begin
- beProcessMouseCommand := False;
-
- {determine position of mouse}
- EvaluateMousePos;
- L := PosResults(FramePos, HotCode);
-
- case HotCode of
- hsNone : {not a hot spot}
- case FramePos of
- frInsideActive : {inside window}
- MouseSelect;
-
- frTL..frRR, {on the frame}
- frInsideFrame, {inside window frame but not in window boundaries}
- frOutsideFrame : {outside window frame}
- beProcessMouseCommand := LongFlagIsSet(wFlags, wAllMouseEvents);
- end;
-
- {$IFDEF UseScrollBars}
- hsDecV : {the decrement fixture of a vertical scroll bar}
- if LongFlagIsSet(beOptions, beMousePage) then
- beScrollUp(Height - 1)
- else if (CurTopIdx = 1) and (CurLineOfs > 0) then
- beTopOfFile
- else
- beScrollUp(1);
- hsDecH : {the decrement fixture of a horizontal scroll bar}
- if XOfs > 0 then begin
- Dec(XOfs);
- beForceRedraw := True;
- end;
- hsIncV : {the increment fixture of a vertical scroll bar}
- if LongFlagIsSet(beOptions, beMousePage) then
- beScrollDown(Height - 1)
- else
- beScrollDown(1);
- hsIncH : {the increment fixture of a horizontal scroll bar}
- if XOfs < (255 - WinWidth) then begin
- Inc(XOfs);
- beForceRedraw := True;
- end;
- hsBar : {the slider portion of a scroll bar}
- case FramePos of
- frLL, frRR : {vertical scroll bar}
- begin
- L := TweakSlider(FramePos, MouseKeyWordY+MouseYLo, L, 1);
- if L <= 1 then
- {goto top of file}
- beTopOfFile
- else begin
- if L >= EList.Size then
- {goto end of file}
- beEndOfFile
- else
- {goto specified line}
- beJumpToLine(Word(L));
- end;
- end;
- else begin {horizontal scroll bar}
- XOfs := Word(TweakSlider(FramePos, MouseKeyWordX+MouseXLo, L, 1));
- beForceRedraw := True;
- end;
- end;
- {$ENDIF}
-
- hsSpot, {a single character hot spot}
- hsRegion0..255 : {a user-defined region relative to a frame}
- beProcessMouseCommand := True;
- end;
-
- end;
- {$ENDIF}
-
- procedure BigEditor.NewFilePrompted;
- {-prompt for a new file}
- var TmpS : String;
- B : Byte;
- W : Integer;
- begin
- if LongFlagIsSet(beOptions,beModified) then begin
- B := beYesNo(0, 'File modified. Save it?', beYes, False);
- if (B = beYes) and (Path <> '') then
- if beStore(Path) then ;
- end;
- TmpS := Path;
- if (beGetFileName(0,'New file: ',TmpS,False,False)) and
- (StUpCase(TmpS) <> Path) then begin
- TmpS := DefaultExtension(TmpS,'PAS');
- beInformation(0,'Working...');
- if NOT beLoad(TmpS,False) then begin
- GotError(epFatal+ecDeviceRead,'Error loading new file');
- SetLastCommand(ccError);
- end
- else ClearLongFlag(beOptions,beModified);
- end;
- beForceRedraw := True;
- beInformation(0,'');
- end;
-
- procedure BigEditor.beSetRightMarginPrompted;
- {-Prompt for a new right margin}
- var
- TMargin : LongInt;
- begin
- TMargin := Margin;
- if beGetNumber(epMessage+mcRightMargin, emRightMargin, TMargin, 1, 127) then
- Margin := TMargin;
- end;
-
- procedure BigEditor.SetBlockIndent(Indent : Byte);
- {-Set block indentation level}
- begin
- if Indent > MaxBlockIndent then
- DefBlockIndent := MaxBlockIndent
- else if Indent > 0 then
- DefBlockIndent := Indent;
- end;
-
- procedure BigEditor.SetDefaultExtension(DefExt : ExtStr);
- {-Default extension to use when prompting for filenames}
- begin
- beDefExt := DefExt;
- end;
-
- procedure BigEditor.SetPrinter(LptNum : Integer);
- begin
- if (LptNum < 1) or (LptNum > 3) then exit;
- beLpt := LptNum;
- end;
-
- procedure BigEditor.beSetBlockIndentPrompted;
- {-Prompt for a new block indentation level}
- var
- Indent : LongInt;
- begin
- Indent := DefBlockIndent;
- if beGetNumber(epMessage+mcIndentLevel, emIndentLevel, Indent, 1, MaxBlockIndent) then
- DefBlockIndent := Indent;
- end;
-
- procedure BigEditor.beSetTabSizePrompted;
- {-Prompt for a new tab size}
- var
- TabSize : LongInt;
- begin
- TabSize := beTabDelta;
- if beGetNumber(epMessage+mcTabSize, emTabSize, TabSize, 1, 10) then
- beTabDelta := TabSize;
- end;
-
-
- procedure BigEditor.ProcessSelf;
- {-main process loop}
- var ProcessDone : Boolean;
- W,N,X : Integer;
- L : LinePtr;
- LI : LongInt;
- B : Byte;
- TmpS : PathStr;
- begin
- Draw;
- W := RawError;
- if W <> 0 then begin
- FastWrite(Pad('Fatal Error '+Long2Str(W),ScreenWidth),1,1,$4F);
- halt;
- end;
- ShowMouse;
- ProcessDone := False;
- SetLongFlag(beOptions,beInProcess);
- with EList do repeat
- beUpdateContents;
- cwCmd := cwCmdPtr^.GetCommand(cwKey);
-
- if LongFlagIsSet(beOptions,beReadOnly) then
- if cwCmd in DisallowedInReadOnlyMode then begin
- cwCmd := ccNone;
- end;
-
- if cwCmd = ccCtrlChar then
- ProcessCtrlChar;
-
- Current := CurLine^.lnReturn;
- case cwCmd of
- ccMouseSel :
- ProcessDone := beProcessMouseCommand;
-
- ccChar :
- beInsertChar(Chr(Lo(cwKey)));
-
- ccSelect :
- beNewLine(True);
-
- ccBlkBegin :
- beSetBkTop;
-
- ccBlkEnd :
- beSetBkBot;
-
- ccSetMark0..ccSetMark9 :
- begin
- Markers[cwCmd-60].Line := CurLine;
- Markers[cwCmd-60].LNum := CurTopIdx+CurLineOfs;
- Markers[cwCmd-60].Col := COfs+XOfs-1;
- SetLongFlag(beOptions,beMarkersOn);
- SetFlag(MarkerFlags,1 shl (cwCmd - 60));
- beForceRedraw := True;
- end;
-
- ccJmpMark0..ccJmpMark9 :
- if Markers[cwCmd-70].Line <> NIL then begin
- beJumpToLinePtr(Markers[cwCmd-70].Line);
- XOfs := 0;
- COfs := 1;
- beCursorRight(Markers[cwCmd-70].Col);
- end;
-
- ccInsertLine :
- beNewLine(False);
-
- ccBack :
- beBackspace;
-
- ccDelLine :
- begin
- beDeleteLinePrim(CurLine);
- beCursorHome;
- beForceRedraw := True;
- end;
-
- ccDel :
- beDeleteCharAtCursor;
-
- ccDelWord :
- beDeleteWordRight;
-
- ccDelEol :
- beDeleteToEndOfLine;
-
- ccUp :
- beLineUp(1);
-
- ccDown :
- beLineDown(1);
-
- ccPageUp :
- if CurTopIdx = 1 then
- beTopOfFile
- else
- beScrollUp(Height - 1);
-
- ccPageDn :
- beScrollDown(Height - 1);
-
- ccScrollUp :
- beScrollUp(1);
-
- ccScrollDn :
- beScrollDown(1);
-
- ccScreenTop :
- begin
- CurLine := CurTop;
- CurLineOfs := 0;
- end;
-
- ccScreenBot :
- begin
- CurLine := CurTop;
- CurLineOfs := 0;
- beLineDown(Height);
- end;
-
- ccTopOfFile :
- beTopOfFile;
-
- ccEndOfFile :
- beEndOfFile;
-
- ccJmpLine :
- begin
- LI := LongInt(CurTopIdx + CurLineOfs);
- if beGetNumber(0,'Jump to line: ',LI,1,EList.Size) then begin
- beJumpToLine(LI);
- beForceRedraw := True;
- end;
- end;
-
- ccTabSize :
- beSetTabSizePrompted;
-
- ccTab :
- beTabOver;
-
- ccLeft :
- beCursorLeft(1);
-
- ccRight :
- beCursorRight(1);
-
- ccHome :
- beCursorHome;
-
- ccEnd :
- beCursorEOL;
-
- ccWordLeft :
- beWordLeft;
-
- ccWordRight :
- beWordRight;
-
- ccMarkToggle :
- begin
- if LongFlagIsSet(beOptions,beMarkersOn) then
- ClearLongFlag(beOptions,beMarkersOn)
- else
- SetLongFlag(beOptions,beMarkersOn);
- beForceRedraw := True;
- end;
-
- ccTabToggle :
- if LongFlagIsSet(beOptions,beSmartTabs) then
- ClearLongFlag(beOptions,beSmartTabs)
- else
- SetLongFlag(beOptions,beSmartTabs);
-
- ccIns :
- if LongFlagIsSet(beOptions,beInsert) then
- ClearLongFlag(beOptions,beInsert)
- else
- SetLongFlag(beOptions,beInsert);
-
- ccIndent :
- if LongFlagIsSet(beOptions,beIndent) then
- ClearLongFlag(beOptions,beIndent)
- else
- SetLongFlag(beOptions,beIndent);
-
- ccRtMargin :
- beSetRightMarginPrompted;
-
- ccCenterLine :
- if beOptionsAreOn(beWordWrap) then
- beCenterLine;
-
- ccWordWrap :
- if LongFlagIsSet(beOptions,beWordWrap) then
- ClearLongFlag(beOptions,beWordWrap)
- else
- SetLongFlag(beOptions,beWordWrap);
-
- ccBlkToggle :
- begin
- if LongFlagIsSet(beOptions,beBlockOn) then
- ClearLongFlag(beOptions,beBlockOn)
- else
- SetLongFlag(beOptions,beBlockOn);
- beForceRedraw := True;
- end;
-
- ccBlkCopy :
- beCopyBlock;
-
- ccBlkMove :
- beMoveBlock;
-
- ccBlkDelete :
- beDeleteBlock;
-
- ccBlkUCase,
- ccBlkLCase,
- ccBlkTCase :
- beChangeCaseBlock(cwCmd);
-
- ccSetIndent :
- beSetBlockIndentPrompted;
-
- ccBlkIndent :
- beIndentBlock(True);
-
- ccBlkUnindent :
- beIndentBlock(False);
-
- ccBlkRead :
- beReadBlock;
-
- ccBlkWord :
- beBlockWord;
-
- ccJmpBegin :
- begin
- if NOT(beOptionsAreOn(beBlockOn)) or
- NOT(beOptionsAreOn(beBlockOK)) then
- GotError(epNonFatal+ecNoBlock,'No block defined')
- else begin
- beJumpToLinePtr(BkTop.Line);
- beCursorHome;
- beCursorRight(BkTop.Col-1);
- end;
- end;
-
- ccJmpEnd :
- begin
- if NOT(beOptionsAreOn(beBlockOn)) or
- NOT(beOptionsAreOn(beBlockOK)) then
- GotError(epNonFatal+ecNoBlock,'No block defined')
- else begin
- beJumpToLinePtr(BkBot.Line);
- beCursorHome;
- beCursorRight(BkBot.Col);
- end;
- end;
-
- ccBlkWrite :
- beWriteBlock(False);
-
- ccBlkPrint :
- beWriteBlock(True);
-
- ccCopy :
- beCopyToClipboard;
-
- ccCut :
- beCutToClipboard;
-
- ccPaste :
- bePasteFromClipboard;
-
- ccSearch :
- beTextSearch(True, bescSearch);
-
- ccReplace :
- beTextSearch(True, bescReplace);
-
- ccReSearch :
- beTextSearch(False, bescSearch);
-
- ccReformatP :
- beReformatPara;
-
- ccReformatG :
- beReformatGlobally;
-
- ccNewFile :
- NewFilePrompted;
-
- ccAbandonFile :
- ProcessDone := True;
-
- ccSaveNamed :
- begin
- TmpS := Path;
- if (beGetFileName(0,'Save file as: ',TmpS,False,False)) and
- (TmpS <> '') then begin
- TmpS := DefaultExtension(TmpS,'PAS');
- beInformation(0,'Working...');
- if not beStore(TmpS) then
- GotError(epNonFatal+ecDeviceWrite,'Error loading new file')
- else
- ClearLongFlag(beOptions,beModified);
- end;
- end;
-
- ccSaveFile :
- if Path <> '' then
- if beStore(Path) then
- ClearLongFlag(beOptions,beModified);
-
- ccSaveSwitch :
- begin
- if Path <> '' then
- if beStore(Path) then
- ClearLongFlag(beOptions,beModified);
- NewFilePrompted;
- end;
-
- ccUser0..ccUser65335,
- ccQuit,
- ccError :
- ProcessDone := True;
-
- else ;
- end;
- until ProcessDone;
- ClearLongFlag(beOptions,beInProcess);
- HideMouse;
- rwSaveWindowState;
- end;
-
- begin
- if NOT BigEdCommands.Init(@BigEdKeySet,BigEdKeyMax) then Halt;
- Clipboard.Init;
- end.
-
-