Организация памяти в текстовом редакторе
Gap buffer
Прикольно. Я ровно такое делал в начале 90-х.
Когда писал один из редакторов под DOS.
Вот тут может быть даже доступны исходники:
http://everesteditor.chat.ru/Resources/Editors/DOS/my/index.htm
https://sourceforge.net/p/rumtmarc/code-0/HEAD/tree/trunk/DOSEditors/
Прикольно,что это всплыло в 2013-м году.
Видимо - "есть потребности".
"
Я уже не первый раз сталкиваюсь с тем, что некоторые технологии, разработанные для старых компьютеров с ограниченными возможностями, оказываются в наше время забытыми, что приводит к распространению неэффективных решений. Надеюсь, что описанное в этой статье «тайное знание предков» поможет появлению на свет хороших текстовых редакторов."
Ну и это перекликается вот с чем -
Рефакторинг. Преодоление "алгоритма маляра".
Всё так или иначе возвращается.
Из старых исходников особенно интересно вот
это:
https://sourceforge.net/p/rumtmarc/code-0/HEAD/tree/trunk/DOSEditors/OLD/SSW.PAS
{$O+}
{$I-}
Unit SSw;
{$DEFINE FROM_SSW}
Interface
{$I DEFINES.INC} { - текущие директивы условной компиляции }
{$I USES.INC}
Const
swOk = 0;
swBoxInvalid = -1;
swBoxNoBlock = -2;
swNonCorrectBlock = -3;
swReadError = -4;
swWriteError = -5;
swCreateError = -6;
swStreamError = -7;
swMemoryError = -8;
Type
TBlockHeader = record
NextPtr,PrevPtr : LongInt;
LenContext : Word;
end;
TBoxHeader = record
CurBlock,FirstBlock : LongInt;
end;
PBoxCollection = ^TBoxCollection;
TBoxCollection = object(TCollection)
Procedure FreeItem(Item : Pointer); virtual;
Function DataSize : Integer; virtual;
end;
const
HdSize = SizeOf(TBlockHeader);
type
PSwapper = ^TSwapper;
TSwapper = object(TObject)
BoxList : PBoxCollection;
{$IFDEF ENCRYPT}
SwFile : PEncryptFilter;
{$ELSE}
SwFile : PLoFile;
{$ENDIF}
{$IFNDEF TEMP}
FName : String;
{$ENDIF}
HeadSwFile : PLoFile;
MaxLenCount: Word;
BlockHd : TBlockHeader;
FreeBox : Integer;
Status : Integer;
Constructor Init({$IFNDEF TEMP}Const aFName: PathStr;{$ENDIF}
aMaxLenCount: Word
{$IFDEF ENCRYPT} ;aKey: LongInt {$ENDIF});
Destructor Done; virtual;
Procedure NewBlockBox(Var BoxNumber: Integer);
Procedure FreeBlockBox(BoxNumber: Integer);
Function GetBlock(BoxNumber:Integer; Var Count: Word; Var Block) : Integer;
Function PutBlock(BoxNumber:Integer; Count: Word; Var Block) : Integer;
Function MoveBlock(SourceBoxNum,DestBoxNum:Integer) : Integer;
Function BoxValid(BoxNumber:Word) : Boolean;
Function EmptyBox(BoxNumber:Word) : Boolean;
function HasError : Boolean;
end;
Implementation
var
TmpCount : Word;
Function TBoxCollection.DataSize: Integer;
Begin
DataSize:=SizeOf(TBoxHeader);
end;
Procedure TBoxCollection.FreeItem(Item : Pointer);
Begin
if Item <> Nil Then FreeMem(Item,DataSize);
end;
Constructor TSwapper.Init({$IFNDEF TEMP}Const aFName: PathStr;{$ENDIF}
aMaxLenCount: Word
{$IFDEF ENCRYPT} ;aKey: LongInt {$ENDIF});
Begin
inherited Init;
Status := swOk;
MaxLenCount:=aMaxLenCount;
{$IFNDEF TEMP}
FName := aFName;
{$ENDIF}
{$IFNDEF TEMP}
{$IFDEF ENCRYPT}
SwFile:=New(PEncryptFilter,Init(aKey,
New(PLoFile,Init(FName+'.sw',stCreate,cBlockSize))));
{$ELSE}
SwFile:=New(PLoFile,Init(FName+'.sw',stCreate,cBlockSize));
{$ENDIF ENCRYPT}
HeadSwFile:=New(PLoFile,Init(FName+'.hsw',stCreate,512));
{$ELSE}
{$IFDEF ENCRYPT}
SwFile:=New(PEncryptFilter,Init(aKey,
New(PTempBufStream,Init(cBlockSize))));
{$ELSE}
SwFile:=New(PTempBufStream,Init(cBlockSize));
{$ENDIF ENCRYPT}
HeadSwFile:=New(PTempBufStream,Init(512));
{$ENDIF TEMP}
if (SwFile = nil) or (HeadSwFile = nil) then
begin
Status := swStreamError;
Exit;
end;
if (SwFile^.Status <> stOk) or (HeadSwFile^.Status <> stOk) then
begin
Status := swCreateError;
Exit;
end;
BoxList:=New(PBoxCollection,Init(5,2));
NewBlockBox(FreeBox);
end;
Destructor TSwapper.Done;
{$IFNDEF TEMP}
var F:File;
{$ENDIF TEMP}
Begin
if (SwFile<>nil) then Dispose(SwFile,Done);
if (HeadSwFile<>nil) then Dispose(HeadSwFile,Done);
if (BoxList<>nil) Then Dispose(BoxList,Done);
{$IFNDEF TEMP}
Assign(F,FName+'.sw');
Erase(F);
Assign(F,FName+'.hsw');
Erase(F);
{$ENDIF}
inherited Done;
end;
Procedure TSwapper.NewBlockBox(Var BoxNumber : Integer);
Var
P : Pointer;
It : Integer;
Function GetFreeElem(Item: Pointer) : Boolean; far;
Begin
GetFreeElem:=(Item=Nil);
end;
Begin
P:=MemAlloc(BoxList^.DataSize);
If P<>Nil
then
Begin
With TBoxHeader(P^) do
Begin
CurBlock:=-1;
FirstBlock:=-1;
end;
end
else
Begin
BoxNumber:=-1;
Status := swMemoryError;
Exit;
end;
It:=BoxList^.IndexOf(Nil);
If It>=0
then
Begin
BoxList^.AtPut(It,P);
BoxNumber:=It;
end
else
Begin
BoxNumber:=BoxList^.Count;
BoxList^.Insert(P);
end;
end;
Function TSwapper.EmptyBox(BoxNumber:Word) : Boolean;
Begin
EmptyBox := not(TBoxHeader(BoxList^.At(BoxNumber)^).CurBlock>0);
end; {TSwapper.EmptyBox}
Procedure TSwapper.FreeBlockBox(BoxNumber : Integer);
Begin
if BoxValid(BoxNumber) Then
begin
if (BoxList^.At(BoxNumber)) <> Nil Then
begin
while(not EmptyBox(BoxNumber)) do
MoveBlock(BoxNumber,FreeBox);
BoxList^.FreeItem(BoxList^.At(BoxNumber));
BoxList^.AtPut(BoxNumber,Nil);
{Связать с пустыми (?!): }
end;
end
else
Status := swBoxInvalid;
end;
Function TSwapper.BoxValid(BoxNumber:Word) : Boolean;
Begin
If (BoxNumber>=0) and (BoxNumber<BoxList^.Count)
then BoxValid:=True
else BoxValid:=False;
end;
Function TSwapper.GetBlock(BoxNumber:Integer;
Var Count: Word;Var Block) : Integer;
Var
CurPtr : LongInt;
Begin
If Not BoxValid(BoxNumber)
then
Begin
Status := swBoxInvalid;
GetBlock:=swBoxInvalid;
Exit;
end;
CurPtr:=TBoxHeader(BoxList^.At(BoxNumber)^).CurBlock;
If CurPtr=-1
then
Begin
Status := swBoxNoBlock;
GetBlock:=swBoxNoBlock;
Exit;
end;
HeadSwFile^.Seek(CurPtr*HdSize);
HeadSwFile^.Read(BlockHd,HdSize);
Count:=BlockHd.LenContext;
SwFile^.Seek(CurPtr*MaxLenCount);
SwFile^.Read(Block,{MaxLen}Count);
if (HeadSwFile^.Status <> stOk) or (SwFile^.Status <> stOk) then
begin
Status := swReadError;
GetBlock:=swReadError;
Exit;
end;
MoveBlock(BoxNumber,FreeBox);
GetBlock:=swOk;
end;
Function TSwapper.PutBlock(BoxNumber:Integer;
Count: Word; Var Block) : Integer;
Var
SwLog : Integer;
CurPtr : LongInt;
i : Word;
const
NULL : Byte = 0;
Begin
If Not BoxValid(BoxNumber)
then
Begin
Status := swBoxInvalid;
PutBlock:=swBoxInvalid;
Exit;
end;
if (Count > MaxLenCount) then Count := MaxLenCount;
BlockHd.LenContext:=Count;
SwLog:=MoveBlock(FreeBox,BoxNumber);
If (SwLog=swOk)
then
Begin
CurPtr := TBoxHeader(BoxList^.At(BoxNumber)^).CurBlock;
HeadSwFile^.Seek(CurPtr*HdSize);
HeadSwFile^.Read(BlockHd,HdSize);
if (HeadSwFile^.Status <> stOk) then
begin
Status := swReadError;
PutBlock:=swReadError;
Exit;
end;
BlockHd.LenContext:=Count;
HeadSwFile^.Seek(CurPtr*HdSize);
HeadSwFile^.Write(BlockHd,HdSize);
if (HeadSwFile^.Status <> stOk) then
begin
Status := swWriteError;
PutBlock:=swWriteError;
Exit;
end;
SwFile^.Seek(CurPtr*MaxLenCount);
SwFile^.Write(Block,{MaxLen}Count);
if (MaxLenCount > Count) then
for i := 1 to MaxLenCount - Count do
SwFile^.Write(NULL,1);
if (SwFile^.Status <> stOk) then
begin
Status := swWriteError;
PutBlock:=swWriteError;
Exit;
end;
PutBlock:=swOk;
end
else PutBlock:=SwLog;
end;
Function TSwapper.MoveBlock(SourceBoxNum,DestBoxNum:Integer) : Integer;
Var
BlockPtr : LongInt;
Begin
If Not (BoxValid(SourceBoxNum) and
BoxValid(DestBoxNum))
then
Begin
Status:=swBoxInvalid;
MoveBlock:=swBoxInvalid;
Exit;
end;
BlockPtr:=TBoxHeader(BoxList^.At(SourceBoxNum)^).CurBlock;
If BlockPtr=-1
then
If SourceBoxNum=FreeBox
then
BlockPtr:=HeadSwFile^.GetSize div HdSize
else
Begin
Status := swBoxNoBlock;
MoveBlock:=swBoxNoBlock;
Exit;
end
else
Begin
HeadSwFile^.Seek(BlockPtr*HdSize);
HeadSwFile^.Read(BlockHd,HdSize);
if (HeadSwFile^.Status <> stOk) then
begin
Status := swReadError;
MoveBlock:=swReadError;
Exit;
end;
TBoxHeader(BoxList^.At(SourceBoxNum)^).CurBlock:=BlockHd.NextPtr;
end;
{Пpисоед. блока BlockPtr к Dest}
BlockHd.NextPtr:=TBoxHeader(BoxList^.At(DestBoxNum)^).CurBlock;
HeadSwFile^.Seek(BlockPtr*HdSize);
HeadSwFile^.Write(BlockHd,HdSize);
if (HeadSwFile^.Status <> stOk) then
begin
Status := swWriteError;
MoveBlock:=swWriteError;
Exit;
end;
If TBoxHeader(BoxList^.At(DestBoxNum)^).CurBlock>=0
then
Begin
HeadSwFile^.Seek(TBoxHeader(BoxList^.At(DestBoxNum)^).CurBlock*HdSize);
HeadSwFile^.Read(BlockHd,HdSize);
if (HeadSwFile^.Status <> stOk) then
begin
Status := swReadError;
MoveBlock:=swReadError;
Exit;
end;
BlockHd.PrevPtr:=BlockPtr;
HeadSwFile^.Seek(TBoxHeader(BoxList^.At(DestBoxNum)^).CurBlock*HdSize);
HeadSwFile^.Write(BlockHd,HdSize);
if (HeadSwFile^.Status <> stOk) then
begin
Status := swWriteError;
MoveBlock:=swWriteError;
Exit;
end;
end
else {Пеpвый блок};
TBoxHeader(BoxList^.At(DestBoxNum)^).CurBlock:=BlockPtr;
MoveBlock:=swOk;
end;
function TSwapper.HasError : Boolean;
var Msg : String;
begin
if (Status=swOk) then
HasError := False
else
begin
HasError := True;
Case Status of
swBoxInvalid: Msg := 'Неправильный номер коробки временного файла.';
swBoxNoBlock: Msg := 'Коробка временного файла пустая.';
swNonCorrectBlock: Msg := 'Неверный блок временного файла.';
swReadError: Msg := 'Ошибка чтения временного файла.';
swWriteError: Msg := 'Ошибка записи временного файла.';
swCreateError: Msg := 'Ошибка создания временного файла.';
swStreamError: Msg := 'Ошибка открытия временного потока.';
swMemoryError: Msg := 'Нехватка памяти для работы с временным файлом.';
else
Msg := 'Неизвестная ошибка временного файла.';
end;
MessageBox(^C+Msg,Nil,mfError+mfOkButton);
end;
end;
{$UNDEF FROM_SSW}
end.
Это собственная реализация
своппинга.
А используется своппинг тут:
https://sourceforge.net/p/rumtmarc/code-0/HEAD/tree/trunk/DOSEditors/OLD/LONGEDIT.PAS
Ну а GapBuffer используется например тут:
https://sourceforge.net/p/rumtmarc/code-0/HEAD/tree/trunk/DOSEditors/OLD/EDITOR.PAS
{$O+}
{$DEFINE FROM_EDITOR}
Unit Editor;
interface
{$I DEFINES.INC} { - текущие директивы условной компиляции }
{$I USES.INC}
{ интерфейс обьекта TEditor - простого редактора коротких файлов }
type
PEditor = ^TEditor;
{$IFNDEF SVISION}
TEditor = object(TView)
{$ELSE}
TEditor = object(TView)
{$ENDIF}
UndoMode: Boolean;
HScrollBar: PLongScrollBar;
VScrollBar: PLongScrollBar;
Indicator: PIndicator;
Buffer: PEditBuffer;
BufSize: Word;
BufLen: Word;
GapLen: Word;
SelStart: Word;
SelEnd: Word;
OSelectMode : Byte; { предыдущий режим выделения блока }
OSelStart : Word; { старое начало блока (до подкачки из коробки) }
OSelEnd : Word; { старый конец блока (до подкачки из коробки) }
CurPtr: Word;
CurPos: TLongPoint;
Delta: TLongPoint;
Limit: TLongPoint;
edDrawLine: LongInt;
DrawPtr: Word;
IsValid: Boolean;
Modified: Boolean;
Selecting: Boolean;
Overwrite: Boolean;
LockCount: Byte;
UpdateFlags: Byte;
KeyState: Integer;
{$IFDEF SVISION}
ScrollNum : LongInt; { количество строк скроллинга в графическом реж}
VertScroll : Word; { шаг вертикального скроллирования }
SCY : Word; { высота привязанного шрифта }
OvSelectMode: Byte; { предыдущий режим выделения блока }
{$ENDIF}
constructor Init(var Bounds: TRect;
AHScrollBar, AVScrollBar: PLongScrollBar;
AIndicator: PIndicator; ABufSize: Word);
constructor Load(var S: TStream);
procedure Store(var S: TStream);
destructor Done; virtual;
{ "стандартные" процедуры поддержки видимого обьекта }
procedure ChangeBounds(var Bounds: TRect); virtual;
function GetPalette: Views.PPalette; virtual;
function CursorVisible: Boolean;
function Valid(Command: Word): Boolean; virtual;
procedure HandleEvent(var Event: TEvent); virtual;
procedure ConvertEvent(var Event: TEvent); virtual;
procedure SetCmdState(Command: Word; Enable: Boolean);
procedure UpdateCommands; virtual;
function GetMousePtr(Mouse: TPoint): Word;
procedure SetState(AState: Word; Enable: Boolean); virtual;
{ работа с буфером редактора }
procedure InitBuffer; virtual;
procedure DoneBuffer; virtual;
function SetBufSize(NewSize: Word): Boolean; virtual;
procedure SetBufLen(Length: Word); virtual;
{ процедуры перемещения по тексту }
procedure SetCurPtr(P: Word; SelectMode: Byte);virtual;
procedure ScrollTo(X, Y: LongInt); virtual;
function GoToBlockStart : Boolean; virtual;
function GoToBlockEnd : Boolean; virtual;
procedure GoToPos(P:TLongPoint);
{ базовые процедуры вставки/удаления }
function InsertBuffer(var P: PEditBuffer; Offset, Length: Word;
AllowUndo, SelectText: Boolean): Boolean; virtual;
function InsertFrom(Editor: PEditor): Boolean; virtual;
function InsertText(Text: Pointer; Length: Word;
SelectText: Boolean): Boolean; virtual;
procedure DeleteRange(StartPtr, EndPtr: Word;
DelSelect: Boolean); virtual;
{ базовые процедуры вставки/удаления для Undo файла}
procedure uInsertText(AText: Pointer; ALen: Integer;
StartPtr: TLongPoint);
procedure uOverwriteText(AText: Pointer; ALen: Integer;
StartPtr: TLongPoint);
procedure uDeleteRange(StartPtr, EndPtr: TLongPoint);
function PointLine(ALine: Integer; var ALineLen: Integer) : Pointer;
{ начало/конец транзакций для Undo-файла }
procedure StartTransaction;
procedure StopTransaction;
{ иммитация нажатия клавиш }
procedure NewLine;
procedure Tab;
procedure Undo; virtual;
function IsClipboard: Boolean;
procedure ToggleInsMode;
{ процедуры низкого уровня для работы с буфером }
function CharPos(P, Target: Word): Integer; virtual;
function CharPtr(P: Word; Target: Integer): Word; virtual;
function BufChar(P: Word): Char;
function BufPtr(P: Word) : Word;
function LineMove(P: Word; Count: Integer): Word;
function LineStart(P: Word): Word; virtual;
function LineEnd(P: Word): Word; virtual;
function NextChar(P: Word): Word; virtual;
function NextLine(P: Word): Word;
function NextWord(P: Word): Word;
function PrevChar(P: Word): Word; virtual;
function PrevLine(P: Word): Word;
function PrevWord(P: Word): Word;
{ процедуры работы с блоками }
procedure SetSelect(NewStart, NewEnd: Word; CurStart: Boolean); virtual;
function ClipCopy: Boolean; virtual;
procedure ClipCut; virtual;
procedure ClipPaste; virtual;
procedure DeleteSelect; virtual;
procedure DeleteBlock; virtual;
function HasSelection: Boolean;
procedure HideSelect; virtual;
procedure StartSelect(P : Word); virtual;
procedure EndSelect(P : Word); virtual;
{ процедуры отрисовки редактора }
procedure Draw; virtual;
procedure DrawLines(Y, Count: Integer; LinePtr: Word); virtual;
procedure FormatLine(var DrawBuf; LinePtr: Word;
Width: Integer; Colors: Word);
procedure TrackCursor(Center: Boolean);
procedure Lock;
procedure Unlock;
procedure Update(AFlags: Byte);
procedure DoUpdate; virtual;
{$IFDEF SVISION}
procedure DoScroll;
function CheckKeys(Key : Word) : Word;
{$ENDIF}
{ процедуры поиска/замены }
function Search(const FindStr: String; Opts: Word): Boolean;
procedure DoSearchReplace; {!!!} virtual;
procedure Find;
procedure Replace;
{ Для форматирования блоков: }
function CorrectSpecial(P, Len : Word) : Integer; virtual;
procedure FormatParagraph(cm : Integer); virtual;
{ сжимает абзац в строку }
function ParagraphToLine(cm : Integer;Ind : Integer) : Boolean;
Procedure LineToParagraph;
Function NextSpace(P : Word) : Word;
{ определяет левый отступ строки }
Function GetIndent(P:Word) : Integer;
{ переносит слово }
Procedure SplitWord(Const FullWord : String; Var SplitPos:Word); virtual;
Procedure SplitStr;
function GetThisWord(P: Word): String;
function ThisWord(P: Word): Word;
end;
function DefEditorDialog(Dialog: Integer; Info: Pointer): Word;
{$IFNDEF SVISION}
function CreateFindDialog: PDialog;
function CreateReplaceDialog: PDialog;
{$ELSE}
function CreateFindDialog: PsDialog;
function CreateReplaceDialog: PsDialog;
{$ENDIF}
function StdEditorDialog(Dialog: Integer; Info: Pointer): Word;
const LongEditWindowNum : Word = 0;
const
SetterInited : Boolean = False;
var
TheSetter : TSetter; { "настройщик" редактора }
{$IFDEF USE_UNDO}
const
UndoFile : PsUndoFile = nil;
{$ENDIF USE_UNDO}
const
Clipboard : PEditor = nil;
const
EditorDialog: TEditorDialog = StdEditorDialog;
{$Ifdef MOST }
EditorFlags: Word = efPromptOnReplace;
{$Else }
EditorFlags: Word = efBackupFiles + efPromptOnReplace;
{$EndIf}
const
FindStr: String[80] = '';
ReplaceStr: String[80] = '';
type
TFindDialogRec = record
Find: String[80];
Options: Word;
end;
type
TReplaceDialogRec = record
Find: String[80];
Replace: String[80];
Options: Word;
end;
implementation
{$I MINMAX.INC}
{$I SCAN.INC }
{$I COUNT.INC }
{ TEditor }
procedure TEditor.StartTransaction;
begin
{$IFDEF USE_UNDO}
if not IsClipboard and (UndoFile <> nil) then
UndoFile^.StartTransaction;
{$ENDIF USE_UNDO}
end;
procedure TEditor.StopTransaction;
begin
{$IFDEF USE_UNDO}
if not IsClipboard and (UndoFile <> nil) then
UndoFile^.StopTransaction;
{$ENDIF USE_UNDO}
end;
procedure TEditor.uInsertText(AText: Pointer; ALen: Integer;
StartPtr: TLongPoint);
begin
UndoMode := True;
GoToPos(StartPtr);
InsertText(AText,ALen,False);
UndoMode := False;
end;
procedure TEditor.uOverwriteText(AText: Pointer; ALen: Integer;
StartPtr: TLongPoint);
begin
UndoMode := True;
GoToPos(StartPtr);
DeleteRange(CurPtr,CurPtr+ALen,False);
GoToPos(StartPtr);
InsertText(AText,ALen,False);
UndoMode := False;
end;
procedure TEditor.uDeleteRange(StartPtr, EndPtr: TLongPoint);
var
OB, OE, OP : TLongPoint;
begin
UndoMode := True;
HideSelect;
GoToPos(StartPtr);
StartSelect(CurPtr);
GoToPos(EndPtr);
EndSelect(CurPtr);
DeleteBlock;
UndoMode := False;
end;
function TEditor.PointLine(ALine: Integer; var ALineLen: Integer) : Pointer;
var
P : TLongPoint;
begin
P.X := 0; P.Y := ALine;
GoToPos(P);
SetCurPtr(LineEnd(CurPtr),0);
ALineLen := LineEnd(CurPtr) - LineStart(CurPtr);
PointLine := @(Buffer^[LineStart(CurPtr)]);
end;
constructor TEditor.Init(var Bounds: TRect;
AHScrollBar, AVScrollBar: PLongScrollBar;
AIndicator: PIndicator; ABufSize: Word);
{$IFDEF SVISION}
var
SV : TsView absolute Self;
{$ENDIF}
begin
inherited Init(Bounds);
GrowMode := gfGrowHiX + gfGrowHiY;
Options := Options or ofSelectable;
{$IFDEF SVISION}
Options := Options or ofClipping;
{$ENDIF}
EventMask := evMouseDown + evKeyDown + evCommand + evBroadcast;
ShowCursor;
HScrollBar := AHScrollBar;
VScrollBar := AVScrollBar;
Indicator := AIndicator;
BufSize := ABufSize;
{$IFDEF SVISION}
VertScroll := 1;
SCY := SV.LinkedFont^.CharHeight;
OvSelectMode := 0;
{$ENDIF}
InitBuffer;
if Buffer <> nil
then IsValid := True
else
begin
IsValid := False;
EditorDialog(edOutOfMemory, nil);
BufSize := 0;
{!!!}
SetBufLen(0);
Exit;
end;
SetBufLen(0);
if (LongEditWindowNum = 0) then
if not(SetterInited) then
begin
SetterInited := True;
if (SetterFileName='') then
TheSetter.Init('')
else
TheSetter.Init(GetPathString+SetterFileName);
end;
end;
constructor TEditor.Load(var S: TStream);
begin
inherited Load(S);
GetPeerViewPtr(S, HScrollBar);
GetPeerViewPtr(S, VScrollBar);
GetPeerViewPtr(S, Indicator);
S.Read(BufSize, SizeOf(Word));
S.Read(SCY,SizeOf(SCY));
InitBuffer;
if Buffer <> nil
then IsValid := True
else
begin
IsValid := False;
EditorDialog(edOutOfMemory, nil);
BufSize := 0;
end;
Lock;
{$IFDEF SVISION}
VertScroll := 1;
{$ENDIF}
UndoMode := False;
SetBufLen(0);
end;
destructor TEditor.Done;
begin
DoneBuffer;
if (LongEditWindowNum = 0)
then
TheSetter.Done;
inherited Done;
end;
function TEditor.BufChar(P: Word): Char; assembler;
asm
LES DI,Self
MOV BX,P
CMP BX,ES:[DI].TEditor.CurPtr
JB @@1
ADD BX,ES:[DI].TEditor.GapLen
@@1:
CMP BX,ES:[DI].TEditor.BufSize
JB @@2
MOV BX,ES:[DI].TEditor.BufSize
DEC BX
@@2: LES DI,ES:[DI].TEditor.Buffer
MOV AL,ES:[DI+BX]
end;
function TEditor.BufPtr(P: Word): Word; assembler;
asm
LES DI,Self
MOV AX,P
CMP AX,ES:[DI].TEditor.CurPtr
JB @@1
ADD AX,ES:[DI].TEditor.GapLen
@@1:
end;
procedure TEditor.ChangeBounds(var Bounds: TRect);
begin
SetBounds(Bounds);
Delta.X := MaxLong(0, MinLong(Delta.X, Limit.X - Size.X div SCX));
Delta.Y := MaxLong(0, MinLong(Delta.Y, Limit.Y - Size.Y div SCY));
Update(ufView);
end;
function TEditor.CharPos(P, Target: Word): Integer;
var
Pos: 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;
function TEditor.CharPtr(P: Word; Target: Integer): Word;
var
Pos: Integer;
begin
Pos := 0;
while (Pos < Target) and (P < BufLen) and (BufChar(P) <> #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;
function TEditor.ClipCopy: Boolean;
begin
ClipCopy := False;
if (Clipboard <> nil) and (Clipboard <> @Self) then
begin
ClipCopy := Clipboard^.InsertFrom(@Self);
Selecting := False;
Update(ufUpdate);
{$IFDEF SVISION}
OvSelectMode := smExtend
{$ENDIF SVISION}
end;
end;
procedure TEditor.ClipCut;
begin
if ClipCopy then DeleteSelect;
end;
procedure TEditor.ClipPaste;
begin
if (Clipboard <> nil) and (Clipboard <> @Self) then
InsertFrom(Clipboard);
end;
procedure TEditor.ConvertEvent(var Event: TEvent);
var
ShiftState: Byte absolute $40:$17;
Key: Word;
begin
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;
function TEditor.CursorVisible: Boolean;
begin
CursorVisible := (CurPos.Y >= Delta.Y) and (CurPos.Y < Delta.Y + Size.Y div SCY);
end;
procedure TEditor.DeleteRange(StartPtr, EndPtr: Word; DelSelect: Boolean);
begin
if HasSelection and DelSelect then DeleteSelect else
begin
SetSelect(StartPtr, EndPtr, True);
DeleteSelect;
end;
end;
procedure TEditor.DeleteSelect;
var
OPos : TLongPoint;
SPos : TLongPoint;
EPos : TLongPoint;
OSS,OSE : Word;
SS,SE : Word;
begin
{$IFDEF USE_UNDO}
if not(IsClipBoard) AND (UndoFile<>nil) AND not(UndoMode) then
begin
OSS := OSelStart; OSE := OSelEnd;
SS := SelStart; SE := SelEnd;
OPos := CurPos;
SetCurPtr(SelStart,0); SPos := CurPos;
SetCurPtr(SelEnd,0); EPos := CurPos;
UndoFile^.InsertText(@Self,SPos,EPos);
if (OPos.X<>SPos.X) OR (OPos.Y<>SPos.Y) then
begin
GoToPos(OPos);
SelStart := SS; SelEnd := SE;
end
else
begin
SetSelect(SS,SE,True);
end;
OSelStart := OSS; OSelEnd := OSE;
end;
{$ENDIF USE_UNDO}
InsertText(nil, 0, False);
end;
procedure TEditor.DeleteBlock;
begin
DeleteSelect;
end;
procedure TEditor.DoneBuffer;
begin
if Buffer <> nil then
begin
FreeMem(Buffer, BufSize);
Buffer := nil;
end;
end;
procedure TEditor.DoSearchReplace;
var
I: Word;
C: TPoint;
begin
repeat
I := cmCancel;
if not Search(FindStr, EditorFlags) then
begin
if EditorFlags and (efReplaceAll + efDoReplace) <>
(efReplaceAll + efDoReplace) then
EditorDialog(edSearchFailed, nil)
end
else if EditorFlags and efDoReplace <> 0 then
begin
I := cmYes;
if EditorFlags and efPromptOnReplace <> 0 then
begin
MakeGlobal(Cursor, C);
I := EditorDialog(edReplacePrompt, Pointer(C));
end;
if I = cmYes then
begin
Lock;
InsertText(@ReplaceStr[1], Length(ReplaceStr), False);
TrackCursor(False);
Unlock;
end;
end;
until (I = cmCancel) or (EditorFlags and efReplaceAll = 0);
end;
{$IFNDEF SVISION}
procedure TEditor.DoUpdate;
begin
if UpdateFlags <> 0 then
begin
if CursorVisible then 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 HScrollBar <> nil then
HScrollBar^.SetParams(Delta.X, 0, Limit.X - Size.X, Size.X div 2, 1);
if VScrollBar <> nil then
VScrollBar^.SetParams(Delta.Y, 0, Limit.Y - Size.Y, Size.Y - 1, 1);
if Indicator <> nil then Indicator^.SetValue(CurPos, Modified);
if State and sfActive <> 0 then UpdateCommands;
UpdateFlags := 0;
end;
end;
{$ELSE}
procedure TEditor.DoUpdate;
var R : TRect;
P : TLongPoint;
OSM : Word;
begin
if UpdateFlags <> 0 then
begin
if (UpdateFlags and ufScroll <> 0)
AND (UpdateFlags and ufBlock = 0)
AND (abs(ScrollNum)<(Size.Y div SCY)-1)
then
DoScroll
else
if (UpdateFlags and ufScroll <> 0)
and (ScrollNum <> 0)
{AND (UpdateFlags and ufBlock = 0)} then
begin
OSM := OSelectMode;
OSelectMode := 0;
P := CurPos; Dec(P.Y,ScrollNum); ScrollNum := 0;
GotoPos(P);
OSelectMode := OSM;
end;
ScrollNum := 0;
if CursorVisible then SetCursor((CurPos.X - Delta.X)*SCX,(CurPos.Y - Delta.Y)*SCY);
if (UpdateFlags and ufView <> 0) or (UpdateFlags and ufBlock <> 0)
then DrawView else
if UpdateFlags and ufLine <> 0 then
begin
R.Assign(0,(CurPos.Y-Delta.Y)*SCY,Size.X,(CurPos.Y-Delta.Y+1)*SCY);
DrawLines((CurPos.Y - Delta.Y)*SCY, SCY, LineStart(CurPtr));
end;
if HScrollBar <> nil then
HScrollBar^.SetParams(Delta.X, 0, Limit.X - Size.X div SCX, (Size.X div SCX) div 2, 1);
if VScrollBar <> nil then
VScrollBar^.SetParams(Delta.Y, 0, Limit.Y - Size.Y div SCY, (Size.Y div SCY) - 1, 1);
if Indicator <> nil then Indicator^.SetValue(CurPos, Modified);
if State and sfActive <> 0 then UpdateCommands;
UpdateFlags := 0;
end;
end;
{$ENDIF SVISION}
{$IFDEF SVISION}
procedure TEditor.DoScroll;
var R : TRect;
DY : Integer;
OPos,P : TLongPoint;
SV : TsView absolute Self;
CursorOn : Boolean;
procedure DrawProc(var R1 : TRect); far;
begin
OPos := CurPos;
if (ScrollNum > 0) then
begin
Inc(R1.B.Y,DY);
GoToPos(Delta);
end
else
begin
Inc(R1.A.Y,DY);
P:=Delta; Inc(P.Y,(Size.Y div SCY)); Inc(P.Y,ScrollNum);
GoToPos(P);
end;
CopyImage(ActivePage,
R1.A.X, R1.A.Y - DY,
R1.B.X-1, R1.B.Y-DY-1,
ActivePage,
R1.A.X, R1.A.Y);
end;
var
OSM : Word;
begin
OSM := OSelectMode;
OSelectMode := 0;
CursorOn := State and sfCursorVis <> 0;
if CursorOn then HideCursor;
HideMouse;
DY := ScrollNum * SCY;
GetExtent(R);
if (ScrollNum > 0) then
R.A.Y := R.A.Y + SCY * ScrollNum
else
R.B.Y := R.A.Y + ((Size.Y div SCY) + ScrollNum) * SCY;
SV.DrawFigure(R,@DrawProc);
DrawLines((CurPos.Y - Delta.Y)*SCY, abs(DY), LineStart(CurPtr));
GetExtent(R);
R.A.Y := R.B.Y - (Size.Y - (Size.Y div SCY) * SCY);
SV.DrawRect(R,True,Lo(GetColor($0301)));
if (OPos.Y >= Delta.Y) and (OPos.Y < Delta.Y + Size.Y div SCY)
then GoToPos(OPos);
UpdateFlags := ufScroll;
ShowMouse;
if CursorOn then ShowCursor;
OSelectMode := OSM;
end;
function TEditor.CheckKeys(Key : Word) : Word; assembler;
asm
PUSH CX
XOR CX,CX
@@LP: MOV AH,1
INT 16H
JE @@1
CMP AX,Key
JNE @@1
MOV AH,0
INT 16H
INC CX
JMP @@LP
@@1: MOV AX,CX
POP CX
end;
{$ENDIF SVISION}
{$IFNDEF SVISION}
procedure TEditor.Draw;
begin
if edDrawLine <> Delta.Y then
begin
DrawPtr := LineMove(DrawPtr, Delta.Y - edDrawLine);
edDrawLine := Delta.Y;
end;
DrawLines(0, Size.Y, DrawPtr);
end;
{$ELSE}
procedure TEditor.Draw;
var
R : Trect;
SV : TsView absolute Self;
begin
if edDrawLine <> Delta.Y then
begin
DrawPtr := LineMove(DrawPtr, Delta.Y - edDrawLine);
edDrawLine := Delta.Y;
end;
DrawLines(0, Size.Y, DrawPtr);
GetExtent(R);
R.A.Y := R.B.Y - (Size.Y - (Size.Y div SCY) * SCY);
SV.DrawRect(R,True,Lo(GetColor($0301)));
end;
{$ENDIF SVISION}
procedure TEditor.DrawLines(Y, Count: Integer; LinePtr: Word);
var
Color: Word;
{$IFDEF SVISION}
bkColor : Word;
SV : TsView absolute Self;
B : array [0..MaxLineLength-1] of Word;
SzX : Word;
S : String;
P : TPoint;
R : TRect;
S1,S2,S3 : String;
C1,C2,C3 : Byte;
B1,B2,B3 : Byte;
procedure BufferToStr(var Buf; var S1, S2, S3: String;
var C1, C2, C3 : Byte;
var B1, B2, B3 : Byte;
Len: Word); near;{assembler;}
var C : Byte;
B : array [0..(MaxLineLength-1)*2] of Byte absolute Buf;
i : Word;
L : Byte;
begin
C := B[1];
L := 0;
S1 := ''; S2 := ''; S3 := '';
for i:=0 to Len*2 do
begin
if (C <> B[i+1]) then
begin
C1 := C;
if (C1 = Lo(Color)) then B1:=Lo(bkColor) else B1:=Hi(bkColor);
C := B[i+1];
break;
end;
Inc(i);
Inc(L);
S1[L] := Char(B[i-1]);
end;
S1[0] := Char(L);
L := 0;
if (i < Len*2) then
for i:=i to Len*2 do
begin
if (C <> B[i+1]) then
begin
C2 := C;
if (C2 = Lo(Color)) then B2:=Lo(bkColor) else B2:=Hi(bkColor);
C := B[i+1];
break;
end;
Inc(i);
Inc(L);
S2[L] := Char(B[i-1]);
end;
S2[0] := Char(L);
L := 0;
if (i < Len*2) then
for i:=i to Len*2 do
begin
if (C <> B[i+1]) then
begin
C3 := C;
if (C3 = Lo(Color)) then B3:=Lo(bkColor) else B3:=Hi(bkColor);
C := B[i+1];
break;
end;
Inc(i);
Inc(L);
S3[L] := Char(B[i-1]);
end;
S3[0] := Char(L);
end;
{asm
PUSH DS
LDS SI,Buf
LES DI,S1
CLD
MOV CX,Len
INC DI
XOR BL,BL
MOV C,0
@@1: LODSB
CMP C,0
JE @@2
CMP C,AL
JNE @@3
@@2: INC BL
LODSB
STOSB
LOOP @@1
@@3:
LES DI,S1
MOV AL,BL
STOSB
POP DS
end;}
{$ELSE}
B: array[0..MaxLineLength - 1] of Word;
{$ENDIF}
begin
{$IFDEF SVISION}
SzX := Size.X div SCX + 1;
P.X := 0;
P.Y := Y;
Color := GetColor($0402);
bkColor:= GetColor($0301);
{$ELSE}
Color := GetColor($0201);
{$ENDIF}
while Count {$IFNDEF SVISION} >0 {$ELSE} >=SCY {$ENDIF} do
begin
{$IFNDEF SVISION}
FormatLine(B, LinePtr, Delta.X + Size.X, Color);
WriteBuf(0, Y, Size.X, 1, B[Delta.X]);
LinePtr := NextLine(LinePtr);
Inc(Y);
Dec(Count);
{$ELSE}
FormatLine(B, LinePtr, Delta.X+SzX, Color);
BufferToStr(B[Delta.X],S1,S2,S3,C1,C2,C3,B1,B2,B3,SzX);
R.A.X := P.X; R.A.Y := P.Y;
R.B := R.A; Inc(R.B.X,Size.X); Inc(R.B.Y,SCY);
SV.DrawSysStr(R,S1,False,C1,B1);
if (S2<>'') then
begin
Inc(R.A.X,Length(S1)*SCX); Inc(R.B.X,Length(S1)*SCX);
SV.DrawSysStr(R,S2,False,C2,B2);
end;
if (S3<>'') then
begin
Inc(R.A.X,Length(S2)*SCX); Inc(R.B.X,Length(S2)*SCX);
SV.DrawSysStr(R,S3,False,C3,B3);
end;
LinePtr := NextLine(LinePtr);
Inc(P.Y,SCY);
Dec(Count,SCY);
{$ENDIF}
end;
end;
procedure TEditor.Find;
var
FindRec: TFindDialogRec;
begin
with FindRec do
begin
Find := FindStr;
Options := EditorFlags;
if EditorDialog(edFind, @FindRec) <> cmCancel then
begin
FindStr := Find;
EditorFlags := Options and not efDoReplace;
DoSearchReplace;
end;
end;
end;
procedure TEditor.FormatLine(var DrawBuf; LinePtr: Word;
Width: Integer; Colors: Word); assembler;
asm
{!!! - Изменена для работы с "нормальными" блоками }
PUSH DS
LDS BX,Self
LES DI,DrawBuf
MOV SI,LinePtr
XOR DX,DX
CLD
MOV AH,Colors.Byte[0]
MOV CX,DS:[BX].TEditor.CurPtr
CMP CX,DS:[BX].TEditor.SelStart
JA @@100
CALL @@10
JMP @@200
@@100: MOV CX,DS:[BX].TEditor.SelStart
CALL @@10
MOV AH,Colors.Byte[1]
MOV CX,DS:[BX].TEditor.CurPtr
CMP CX,DS:[BX].TEditor.SelEnd
JA @@300
CALL @@10
ADD SI,DS:[BX].TEditor.GapLen
JMP @@400
@@300: MOV CX,DS:[BX].TEditor.SelEnd
CALL @@10
MOV AH,Colors.Byte[0]
MOV CX,DS:[BX].TEditor.CurPtr
CALL @@10
ADD SI,DS:[BX].TEditor.GapLen
JMP @@500
@@200: ADD SI,DS:[BX].TEditor.GapLen
MOV CX,DS:[BX].TEditor.SelStart
ADD CX,DS:[BX].TEditor.GapLen
CALL @@10
@@400: MOV AH,Colors.Byte[1]
MOV CX,DS:[BX].TEditor.SelEnd
ADD CX,DS:[BX].TEditor.GapLen
CALL @@10
@@500: MOV AH,Colors.Byte[0]
MOV CX,DS:[BX].TEditor.BufSize
CALL @@10
JMP @@31
@@10: SUB CX,SI
JA @@11
RETN
@@11: LDS BX,DS:[BX].TEditor.Buffer
ADD SI,BX
MOV BX,Width
@@12: LODSB
CMP AL,' '
JB @@20
{ $IFNDEF SVISION}
@@13: STOSW
(*{$ELSE}
@@13: STOSB
{$ENDIF}*)
INC DX
@@14: CMP DX,BX
JAE @@30
LOOP @@12
LDS BX,Self
SUB SI,DS:[BX].TEditor.Buffer.Word[0]
RETN
@@20: CMP AL,0DH
JE @@30
CMP AL,09H
JNE @@13
MOV AL,' '
{ $IFNDEF SVISION}
@@21: STOSW
(*{$ELSE}
@@21: STOSB
{$ENDIF}*)
INC DX
TEST DL,7
JNE @@21
JMP @@14
@@30: POP CX
{$IFNDEF SVISION}
@@31: MOV AL,' '
{$ELSE}
@@31: MOV AL,00
{$ENDIF}
MOV CX,Width
SUB CX,DX
JBE @@32
REP STOSW
@@32: POP DS
end;
function TEditor.GetMousePtr(Mouse: TPoint): Word;
begin
MakeLocal(Mouse, Mouse);
Mouse.X:=Mouse.X div SCX; Mouse.Y:=Mouse.Y div SCY;
Mouse.X := Max(0, Min(Mouse.X, Size.X div SCX - 1));
Mouse.Y := Max(0, Min(Mouse.Y, Size.Y div SCY - 1));
GetMousePtr := CharPtr(LineMove(DrawPtr, Mouse.Y + Delta.Y - edDrawLine),
Mouse.X + Delta.X);
end;
function TEditor.GetPalette:Views.PPalette;
const
P: String[Length(CEditor)] = CEditor;
begin
GetPalette := @P;
end;
function TEditor.ThisWord(P: Word): Word;
Begin
If (P > 0) then
While (P > 0) and (BufChar(PrevChar(P)) in WordChars)
do P := PrevChar(P);
ThisWord:=P;
end;
function TEditor.GetThisWord(P: Word): String;
Var
AThisWord : String;
Begin
AThisWord:='';
P:=ThisWord(P);
While (P < BufLen) and (BufChar(P) in WordChars) do
Begin
AThisWord:=AThisWord+BufChar(P);
P := NextChar(P);
end;
GetThisWord:=AThisWord;
end;
function TEditor.GoToBlockStart : Boolean;
begin
GoToBlockStart := True;
SetCurPtr(SelStart,0);
end;
function TEditor.GoToBlockEnd : Boolean;
begin
GoToBlockEnd := True;
SetCurPtr(SelEnd,0);
end;
procedure TEditor.GoToPos(P:TLongPoint);
var
i : LongInt;
Lim : LongInt;
begin
if (P.X=CurPos.X) AND (P.Y=CurPos.Y) then Exit;
{$IFDEF SVISION} Inc(LockCount); {$ENDIF}
if P.Y <> CurPos.Y then
begin
Lim := P.Y - CurPos.Y;
for i:=1 To abs(Lim) do
SetCurPtr(LineMove(CurPtr,Lim div abs(Lim)),0);
end;
SetCurPtr(LineStart(CurPtr),0);
if (P.X<=CharPos(CurPtr,LineEnd(CurPtr))) then
for i:=1 To P.X do
SetCurPtr(NextChar(CurPtr),0);
{$IFDEF SVISION} Dec(LockCount); {$ENDIF}
end;
procedure TEditor.HandleEvent(var Event: TEvent);
var
ShiftState : Byte absolute $40:$17;
CenterCursor: Boolean;
SelectMode : Byte;
i : Integer;
NewPtr : Word;
D : TLongPoint;
Mouse : TPoint;
{$IFDEF SVISION}
ODelta : TLongPoint;
SV : TsView absolute Self;
{$ENDIF}
procedure CheckScrollBar(P: PLongScrollBar; var D: {$IFNDEF SVISION}
LongInt
{$ELSE}
Integer
{$ENDIF});
{$IFDEF SVISION}
var ODelta : TLongPoint;
{$ENDIF}
begin
if (Event.InfoPtr = P) and (P^.Value <> D) then
begin
{$IFDEF SVISION}
ODelta := Delta;
{$ENDIF}
D := P^.Value;
{$IFDEF SVISION}
if (ODelta.Y<>Delta.Y) then
Message(@Self,evCommand,cmSetScroll,Pointer(ODelta.Y-Delta.Y))
else
Update(ufView);
{$ELSE}
Update(ufView);
{$ENDIF}
end;
end;
begin
{$IFDEF SVISION}
ScrollNum := 0;
SCY := SV.LinkedFont^.CharHeight;
{$ENDIF}
inherited HandleEvent(Event);
ConvertEvent(Event);
CenterCursor := not CursorVisible;
SelectMode := 0;
if Selecting or (ShiftState and $03 <> 0) then SelectMode := smExtend;
{$IFDEF SVISION}
if (SelectMode = smExtend) then UpdateFlags := ufView or ufBlock
else if (OvSelectMode = smExtend) OR (OvSelectMode = smDrag)
then UpdateFlags := ufView or ufBlock;
OvSelectMode := SelectMode;
{$ENDIF}
case Event.What of
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;
UpdateFlags := ufView {$IFDEF SVISION} {or ufBlock} {$ENDIF};
{$IFDEF SVISION}
OvSelectMode := smDrag;
{$ENDIF}
Unlock;
until not MouseEvent(Event, evMouseMove + evMouseAuto);
end;
evKeyDown:
case Event.CharCode of
#32..#255:
begin
Lock;
if Overwrite
{and not HasSelection}
and (CurPtr <> LineEnd(CurPtr))
then
begin
DeleteRange(CurPtr,CurPtr+1,False);
end; {SelEnd := NextChar(CurPtr)};
If (Event.CharCode in [#32])
and (CurPtr >= LineStart(CurPtr)+TheSetter._R.StrLen-1)
then NewLine
else InsertText(@Event.CharCode, 1, False);
TrackCursor(False);
Unlock;
end;
else
Exit;
end;
evCommand:
case Event.Command of
cmFind: Find;
cmReplace: Replace;
cmSearchAgain: DoSearchReplace;
else
begin
Lock;
case Event.Command of
cmTab: Tab;
cmCut: ClipCut;
cmCopy: ClipCopy;
cmPaste: ClipPaste;
cmUndo: Undo;
cmClear: DeleteSelect;
cmCharLeft: {$IFNDEF SVISION}
SetCurPtr(PrevChar(CurPtr), SelectMode);
{$ELSE}
for i:= 1 to CheckKeys(kbLeft)+1 do
begin
SetCurPtr(PrevChar(CurPtr), SelectMode);
end;
{$ENDIF SVISION}
cmCharRight:{$IFNDEF SVISION}
SetCurPtr(NextChar(CurPtr), SelectMode);
{$ELSE}
for i:= 1 to CheckKeys(kbRight)+1 do
begin
SetCurPtr(NextChar(CurPtr), SelectMode);
end;
{$ENDIF}
cmWordLeft: SetCurPtr(PrevWord(CurPtr), SelectMode);
cmWordRight: SetCurPtr(NextWord(CurPtr), SelectMode);
cmLineStart: SetCurPtr(LineStart(CurPtr), SelectMode);
cmLineEnd: SetCurPtr(LineEnd(CurPtr), SelectMode);
cmLineUp: {$IFNDEF SVISION}
SetCurPtr(LineMove(CurPtr, -1), SelectMode);
{$ELSE}
begin
ScrollNum := VertScroll * (CheckKeys(kbUp)+1);
if (ScrollNum > (CurPos.Y)) then
ScrollNum := CurPos.Y;
SetCurPtr(LineMove(CurPtr, -ScrollNum), SelectMode);
end;
{$ENDIF}
cmLineDown:{$IFNDEF SVISION}
SetCurPtr(LineMove(CurPtr, 1), SelectMode);
{$ELSE}
begin
ScrollNum := -VertScroll * (CheckKeys(kbDown)+1);
if (-ScrollNum > (Limit.Y-CurPos.Y)) then
ScrollNum := CurPos.Y - Limit.Y;
SetCurPtr(LineMove(CurPtr, -ScrollNum), SelectMode);
end;
{$ENDIF}
cmPageUp: {$IFNDEF SVISION}
SetCurPtr(LineMove(CurPtr, -(Size.Y div SCY - 1)), SelectMode);
{$ELSE}
SetCurPtr(LineMove(CurPtr, -(Size.Y div SCY - 1)*(CheckKeys(kbPgUp)+1)), SelectMode);
{$ENDIF}
cmPageDown:{$IFNDEF SVISION}
SetCurPtr(LineMove(CurPtr, (Size.Y div SCY - 1)), SelectMode);
{$ELSE}
SetCurPtr(LineMove(CurPtr, (Size.Y div SCY - 1)*(CheckKeys(kbPgDn)+1)), SelectMode);
{$ENDIF}
cmTextStart: SetCurPtr(0, SelectMode);
cmTextEnd: SetCurPtr(BufLen, SelectMode);
cmNewLine: NewLine;
cmBackSpace: DeleteRange(PrevChar(CurPtr), CurPtr, False);
cmDelChar: DeleteRange(CurPtr, NextChar(CurPtr), False);
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(CurPtr);
cmHideSelect: HideSelect;
cmIndentMode: TheSetter._R.AutoIndent := not TheSetter._R.AutoIndent;
{$IFDEF SVISION}
cmSetScroll : begin
ScrollNum := Integer(Event.InfoPtr);
if (ScrollNum <> 0) then
UpdateFlags := (UpdateFlags and ufBlock)
or ufView or ufScroll;
UnLock;
ClearEvent(Event);
Exit;
end;
{$ENDIF}
else
Unlock;
Exit;
end;
{$IFDEF SVISION}
ODelta := Delta;
TrackCursor(False);
if (ScrollNum <> 0) AND (ODelta.Y<>Delta.Y) then
begin
Dec(LockCount);
Message(@Self,evCommand,cmSetScroll,Pointer(ScrollNum));
ClearEvent(Event);
Exit;
end;
{$ELSE}
TrackCursor(False);
{$ENDIF SVISION}
Unlock;
end;
end;
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;
end;
ClearEvent(Event);
end;
function TEditor.HasSelection: Boolean;
begin
HasSelection := SelStart <> SelEnd;
end;
procedure TEditor.HideSelect;
begin
Selecting := False;
SetSelect(CurPtr, CurPtr, False);
{$IFDEF SVISION}
UpdateFlags := ufView or ufBlock;
{$ENDIF SVISION}
end;
procedure TEditor.InitBuffer;
begin
Buffer := MemAlloc(BufSize);
end;
function TEditor.InsertBuffer(var P: PEditBuffer; Offset, Length: Word;
AllowUndo, SelectText: Boolean): Boolean;
var
SelLen, DelLen, SelLines, Lines: Word;
NewSize,Dum: Longint;
OCurPos : TLongPoint;
begin
OCurPos := CurPos;
InsertBuffer := True;
Selecting := False;
SelLen := SelEnd - SelStart;
if (SelLen = 0) and (Length = 0) then Exit;
DelLen := 0;
if (SelLen > 0) then DelLen := SelLen;
NewSize := Longint(BufLen - SelLen + DelLen) + Length;
if (NewSize > $FFF0) then
NewSize := $FFF1;
if (NewSize > BufSize) then
if not SetBufSize(NewSize) then
begin
EditorDialog(edOutOfMemory, nil);
InsertBuffer := False;
SelEnd := SelStart;
Exit;
end;
if (SelLen > 0) then
SelLines := CountLines(Buffer^[BufPtr(SelStart)], SelLen)
else
SelLines := 0;
if (CurPtr = SelEnd) AND (SelLen > 0) then
begin
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);
edDrawLine := CurPos.Y;
DrawPtr := LineStart(CurPtr);
CurPos.X := CharPos(DrawPtr, CurPtr);
if not SelectText then SelStart := CurPtr;
SelEnd := CurPtr;
Dum:=Length; Dum:=Dum-SelLen;
Inc(BufLen,Dum);
Dec(GapLen,Dum);
Dum:=Lines; Dum:=Dum-SelLines;
Inc(Limit.Y,Dum);
Delta.Y := MaxLong(0, MinLong(Delta.Y, Limit.Y - Size.Y div SCY));
if not(IsClipboard) then Modified := True;
{$IFDEF USE_UNDO}
if (UndoFile<>nil) AND not(IsClipBoard) AND not(UndoMode) then
UndoFile^.DeleteRange(OCurPos,CurPos);
{$ENDIF USE_UNDO}
SetBufSize(BufLen);
if (SelLines = 0) and (Lines = 0) then Update(ufLine) else Update(ufView);
end;
function TEditor.InsertFrom(Editor: PEditor): Boolean;
begin
InsertFrom := InsertBuffer(Editor^.Buffer,
Editor^.BufPtr(Editor^.SelStart),
Editor^.SelEnd - Editor^.SelStart, False, IsClipboard);
end;
function TEditor.InsertText(Text: Pointer; Length: Word;
SelectText: Boolean): Boolean;
begin
InsertText:=InsertBuffer(PEditBuffer(Text),
0, Length, False, SelectText);
end;
function TEditor.IsClipboard: Boolean;
begin
IsClipboard := (Clipboard = @Self);
end;
function TEditor.LineEnd(P: Word): Word; assembler;
asm
PUSH DS
LDS SI,Self
LES BX,DS:[SI].TEditor.Buffer
MOV DI,P
MOV AL,0DH
CLD
MOV CX,DS:[SI].TEditor.CurPtr
SUB CX,DI
JBE @@1
ADD DI,BX
REPNE SCASB
JE @@2
MOV DI,DS:[SI].TEditor.CurPtr
@@1: MOV CX,DS:[SI].TEditor.BufLen
SUB CX,DI
JCXZ @@4
ADD BX,DS:[SI].TEditor.GapLen
ADD DI,BX
REPNE SCASB
JNE @@3
@@2: DEC DI
@@3: SUB DI,BX
@@4: MOV AX,DI
POP DS
end;
function TEditor.LineMove(P: Word; Count: Integer): Word;
var
Pos: Integer;
I: 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;
function TEditor.LineStart(P: Word): Word; assembler;
asm
PUSH DS
LDS SI,Self
LES BX,DS:[SI].TEditor.Buffer
MOV DI,P
MOV AL,0DH
STD
MOV CX,DI
SUB CX,DS:[SI].TEditor.CurPtr
JBE @@1
ADD BX,DS:[SI].TEditor.GapLen
ADD DI,BX
DEC DI
REPNE SCASB
JE @@2
SUB BX,DS:[SI].TEditor.GapLen
MOV DI,DS:[SI].TEditor.CurPtr
@@1: MOV CX,DI
JCXZ @@4
ADD DI,BX
DEC DI
REPNE SCASB
JNE @@3
@@2: INC DI
INC DI
SUB DI,BX
CMP DI,DS:[SI].TEditor.CurPtr
JE @@4
CMP DI,DS:[SI].TEditor.BufLen
JE @@4
CMP ES:[BX+DI].Byte,0AH
JNE @@4
INC DI
JMP @@4
@@3: XOR DI,DI
@@4: MOV AX,DI
POP DS
end;
procedure TEditor.Lock;
begin
Inc(LockCount);
end;
procedure TEditor.NewLine;
const
CrLf: array[1..2] of Char = #13#10;
InChar : Char =' ';
var
I,B,ILen: Word;
begin
B := LineStart(CurPtr);
InsertText(@CrLf, 2, False);
if TheSetter._R.AutoIndent
then
If TheSetter._R.IndentLen<0 data-blogger-escaped-:="B;" data-blogger-escaped-and="" data-blogger-escaped-begin="" data-blogger-escaped-curptr="" data-blogger-escaped-do="" data-blogger-escaped-else="" data-blogger-escaped-end="" data-blogger-escaped-false="" data-blogger-escaped-i="" data-blogger-escaped-if="" data-blogger-escaped-inc="" data-blogger-escaped-inserttext="" data-blogger-escaped-or="" data-blogger-escaped-then="" data-blogger-escaped-thesetter._r.indentlen="" data-blogger-escaped-uffer="" data-blogger-escaped-while="">0 then
For i:=0 to TheSetter._R.IndentLen-1 do
InsertText(@InChar,1, False);
end;
function TEditor.NextChar(P: Word): Word; assembler;
asm
PUSH DS
LDS SI,Self
MOV DI,P
CMP DI,DS:[SI].TEditor.BufLen
JE @@3
INC DI
CMP DI,DS:[SI].TEditor.BufLen
JE @@3
LES BX,DS:[SI].TEditor.Buffer
CMP DI,DS:[SI].TEditor.CurPtr
JB @@1
ADD BX,DS:[SI].TEditor.GapLen
@@1: CMP ES:[BX+DI-1].Word,0A0DH
JNE @@2
INC DI
@@2: {!!!}
@@3:
CMP DI,DS:[SI].TEditor.BufSize
JB @@4
MOV DI,DS:[SI].TEditor.BufSize
DEC DI
@@4:
MOV AX,DI
POP DS
end;
function TEditor.NextLine(P: Word): Word;
begin
NextLine := NextChar(LineEnd(P));
end;
function TEditor.NextWord(P: Word): Word;
begin
while (P < BufLen) and (BufChar(P) in WordChars) do
P := NextChar(P);
while (P < BufLen) and not (BufChar(P) in WordChars) do
P := NextChar(P);
NextWord := P;
end;
function TEditor.PrevChar(P: Word): Word; assembler;
asm
PUSH DS
LDS SI,Self
MOV DI,P
OR DI,DI
JE @@3
DEC DI
JE @@3
LES BX,DS:[SI].TEditor.Buffer
CMP DI,DS:[SI].TEditor.CurPtr
JB @@1
ADD BX,DS:[SI].TEditor.GapLen
@@1: CMP ES:[BX+DI-1].Word,0A0DH
JNE @@2
DEC DI
@@2: {!!!}
@@3:
MOV AX,DI
POP DS
end;
function TEditor.PrevLine(P: Word): Word;
begin
PrevLine := LineStart(PrevChar(P));
end;
function TEditor.PrevWord(P: Word): Word;
begin
while (P > 0) and not (BufChar(PrevChar(P)) in WordChars) do
P := PrevChar(P);
while (P > 0) and (BufChar(PrevChar(P)) in WordChars) do
P := PrevChar(P);
PrevWord := P;
end;
procedure TEditor.Replace;
var
ReplaceRec: TReplaceDialogRec;
begin
with ReplaceRec do
begin
Find := FindStr;
Replace := ReplaceStr;
Options := EditorFlags;
if EditorDialog(edReplace, @ReplaceRec) <> cmCancel then
begin
FindStr := Find;
ReplaceStr := Replace;
EditorFlags := Options or efDoReplace;
DoSearchReplace;
end;
end;
end;
procedure TEditor.ScrollTo(X, Y: LongInt);
begin
X := MaxLong(0, MinLong(X, Limit.X - Size.X div SCX));
Y := MaxLong(0, MinLong(Y, Limit.Y - Size.Y div SCY));
{!!!}
if (X <> Delta.X) or (Y <> Delta.Y) then
begin
Delta.X := X;
Delta.Y := Y;
Update(ufView);
end;
end;
function TEditor.Search(const FindStr: String; Opts: Word): Boolean;
var
I, Pos: Word;
begin
Search := False;
Pos := CurPtr;
repeat
if Opts and efCaseSensitive <> 0 then
I := Scan(Buffer^[BufPtr(Pos)], BufLen - Pos, FindStr,0)
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;
SetCurPtr(I,0);
StartSelect(CurPtr);
EndSelect(CurPtr + Length(FindStr));
Selecting := False;
{$IFDEF SVISION}
OvSelectMode := smExtend;
{$ENDIF}
TrackCursor(not CursorVisible);
Unlock;
Search := True;
Exit;
end else Pos := I + 1;
end;
until I = sfSearchFailed;
end;
procedure TEditor.SetBufLen(Length: 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;
Limit.X := MaxLineLength;
Limit.Y := CountLines(Buffer^[GapLen], BufLen) + 1;
edDrawLine := 0;
DrawPtr := 0;
Modified := False;
Update(ufView);
end;
function TEditor.SetBufSize(NewSize: Word): Boolean;
begin
SetBufSize := NewSize <= BufSize;
end;
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;
procedure TEditor.SetCurPtr(P: Word; SelectMode: Byte);
var
Anchor: 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;
procedure TEditor.SetSelect(NewStart, NewEnd: Word; CurStart: Boolean);
var
Flags: Byte;
P, L: Word;
begin
if CurStart then P := NewStart else P := NewEnd;
Flags := ufUpdate;
{$IFNDEF SVISION}
if (NewStart <> SelStart) or (NewEnd <> SelEnd) then
if (NewStart <> NewEnd) or (SelStart <> SelEnd) then
Flags := ufView;
{$ENDIF}
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;
edDrawLine := CurPos.Y;
DrawPtr := LineStart(P);
CurPos.X := CharPos(DrawPtr, P);
SetBufSize(BufLen);
end;
SelStart := NewStart;
SelEnd := NewEnd;
Update(Flags);
end;
procedure TEditor.SetState(AState: Word; Enable: Boolean);
begin
inherited SetState(AState, Enable);
case AState of
sfActive:
begin
if HScrollBar <> nil then HScrollBar^.SetState(sfVisible, Enable);
if VScrollBar <> nil then VScrollBar^.SetState(sfVisible, Enable);
if Indicator <> nil then Indicator^.SetState(sfVisible, Enable);
{$IFDEF USE_UNDO}
if Enable AND (UndoFile <> nil) then UndoFile^.Clear;
{$ENDIF USE_UNDO}
UpdateCommands;
end;
sfExposed:
if Enable then Unlock;
end;
end;
Procedure TEditor.SplitWord(Const FullWord : String; Var SplitPos:Word);
Var
I : Byte;
Len : Byte;
Function GlasnPresent(Const Slog : String) : Boolean;
Var
I : Byte;
Begin
GlasnPresent:=False;
For I:=1 to Length(Slog) do
If Slog[I] in Glasn
then
Begin
GlasnPresent:=True;
Break;
end;
end;
Function ValidSlog(Const Slog : String;SlogNum : Byte) : Boolean;
Begin
If (Length(Slog)>1) and
GlasnPresent(Slog) and
((SlogNum=1) or Not (Slog[1] in Znaks))
then ValidSlog:=True
else ValidSlog:=False;
end;
Begin
if TheSetter._R.MaySplit then
begin
Len := Length(FullWord);
While SplitPos>1 do
Begin
If ValidSlog(Copy(FullWord,1,SplitPos),1) and
ValidSlog(Copy(FullWord,SplitPos+1,Len),2) and
((FullWord[SplitPos] in Glasn+Znaks) or
Not (FullWord[SplitPos+1] in Glasn))
then Exit
else Dec(SplitPos);
end;
SplitPos:=0;
end
else
SplitPos := 0;
end;
Function TEditor.GetIndent(P:Word) : Integer;
Var
I : Integer;
Begin
P:=LineStart(P);
I:=0;
if (BufChar(P)=#13) then I:=-1
else
While (P<BufLen) AND (BufChar(P)=#32) do
Begin
Inc(I);
{ Inc(P);}
P:=NextChar(P);
end;
GetIndent:=I;
end;
Function TEditor.NextSpace(P : Word) : Word;
const SP : Char = #32;
Begin
Repeat
P:=NextChar(P);
if BufChar(P)=#9 then
begin
DeleteRange(P,NextChar(P),False);
InsertText(@SP,1,False);
end;
until (BufChar(P)=#32) or (P+1 >= BufLen);
NextSpace:=P;
end;
function TEditor.ParagraphToLine(cm : Integer; Ind : Integer) : Boolean;
Var
P : Word;
OP : TLongPoint;
Cnt : LongInt;
SCnt : String;
Begin
Cnt := 0; SCnt := '';
CtrlBreakHit := False;
ParagraphToLine := True;
OP := CurPos;
P := LineStart(CurPtr);
{!!!}
if ((cm = cmFormatInt) AND (GetIndent(P)<>TheSetter._R.FirstLineIndent)) then
Ind:=GetIndent(P);
If (BufChar(LineStart(CurPtr)) = #32)
then
If (NextWord(P)<=LineEnd(CurPtr))
then P:=NextWord(P)
else
Begin
SetCurPtr(LineStart(NextLine(P)),0);
EXIT;
end;
Repeat
Inc(Cnt);
Str(Cnt,SCnt);
SCnt := 'Просмотрено: ' + SCnt + ' строк.';
DecStatusCount;
SetNewStatus(SCnt);
While (NextSpace(P)<LineEnd(P)) do
Begin
P:=NextSpace(P);
SetCurPtr(P,0);
If (BufChar(NextChar(P))=#32)
then
Begin
While (P<BufLen) AND (BufChar(NextChar(P))=#32) do P:=NextChar(P);
DeleteRange(CurPtr,P,False);
end;
P:=CurPtr;
end;
If (P >= BufLen) then exit;
{!!!}
If (Ind = -1) then Ind:=GetIndent(NextLine(P));
If (Ind >=0) AND
((cm = cmFormatInt) AND (GetIndent(NextLine(P))=Ind)) XOR
((cm = cmFormatNew) AND (GetIndent(NextLine(P))=Ind)) XOR
((cm = cmFormat) AND (GetIndent(NextLine(P))=TheSetter._R.IndentLen))
then
Begin
{!!!}
SetCurPtr(LineEnd(P),0);
P:=NextLine(P);
If P >= BufLen then exit;
P:=LineStart(P);
While (P<BufLen) AND (BufChar(P)=#32) do P:=NextChar(P);
DeleteRange(CurPtr,P,False);
P:=PrevChar(CurPtr);
If (BufChar(P)=CarrySign) and
(BufChar(PrevChar(P)) in WordChars) and
(BufChar(NextChar(P)) in WordChars)
then
DeleteRange(P,NextChar(P),False)
else
If (BufChar(P)<>#32)
then
Begin
SetCurPtr(NextChar(P),0);
InsertText(@SpaceCh,1,False);
end;
end
else
Begin
Break;
end;
until CtrlBreakHit {и не конец файла};
if CtrlBreakHit then
begin
CtrlBreakHit := False;
ParagraphToLine := False;
end;
GoToPos(OP);
CtrlBreakHit := False;
end;
Procedure TEditor.LineToParagraph;
var
Cnt : LongInt;
SCnt : String;
Begin
Cnt := 0; SCnt := '';
While (LineEnd(CurPtr)-LineStart(CurPtr)>TheSetter._R.StrLen) do
begin
Inc(Cnt);
Str(Cnt,SCnt);
SCnt := 'Отформатировано: ' + SCnt + ' строк.';
DecStatusCount;
SetNewStatus(SCnt);
Splitstr;
end;
end;
procedure TEditor.FormatParagraph(cm : Integer);
var
LS : Word;
Ind: Integer;
S : String;
i : integer;
Begin
SetNewStatus('Форматирование абзаца...');
StartTransaction;
Ind := -1;
if (cm = cmFormatNew) then
begin
LS := LineStart(CurPtr);
Ind := GetIndent(CurPtr);
if (Ind>0) then DeleteRange(LS,LS+Ind,False);
if (TheSetter._R.FirstLineIndent > 0) then
begin
S := '';
for i:=1 to TheSetter._R.FirstLineIndent do
S := S + #32;
SetCurPtr(LineStart(CurPtr),0);
InsertText(@S[1],Length(S),False);
SetCurPtr(LineStart(CurPtr),0);
end;
end;
if ParagraphToLine(cm,-1) then
LineToParagraph;
SetCurPtr(NextLine(CurPtr),0);
StopTransaction;
SetOldStatus;
end;
function TEditor.CorrectSpecial(P, Len : Word) : Integer;
begin
CorrectSpecial := 0;
end;
Procedure TEditor.SplitStr;
Var
SpWord : String;
SplitNum : Word;
DecSpNum : Integer;
SaveCurPtr : Word;
P : Word;
IncrCh : Integer;
SLen : Word;
Begin
IncrCh:=0;
DecSpNum:=0;
SaveCurPtr:=CurPtr;
SLen := TheSetter._R.StrLen;
SLen := SLen+CorrectSpecial(LineStart(CurPtr),SLen);
P:=LineStart(CurPtr)+SLen;
SpWord:=GetThisWord(P);
If SpWord=''
then While BufChar(PrevChar(P))=#32 do P:=PrevChar(P)
else
If (ThisWord(P)>=P-1)
then
Begin
P:=ThisWord(P);
While BufChar(PrevChar(P))=#32 do P:=PrevChar(P)
end
else
Begin
P:=ThisWord(P);
SplitNum:=LineStart(P)+SLen-1;
SplitNum:=SplitNum-P;
SplitWord(SpWord,SplitNum);
If SplitNum>0
then
Begin
SetCurPtr(P+SplitNum,0);
InsertText(@CarrySign, 1, False);
P:=CurPtr;
end
else
While BufChar(PrevChar(P))=' ' do P:=PrevChar(P);
end;
if TheSetter._R.MaySmooth then
begin
IncrCh:=LineStart(CurPtr)+SLen-P;
If (IncrCh>0)
and (LineStart(P)<PrevWord(P))
and (LineStart(P)<PrevWord(PrevWord(P)))
then
Begin
While IncrCh>0 do
Begin
While (LineStart(P)<PrevWord(PrevWord(P)))
and (IncrCh>0) do
Begin
P:=PrevWord(P);
SetCurPtr(P,0);
InsertText(@SpaceCh, 1, False);
Dec(IncrCh);
end;
P:=LineStart(P)+SLen-IncrCh;
end;
P:=LineStart(P)+SLen;
end;
end;{if MaySmooth ...}
SetCurPtr(P,0);
NewLine;
P:=LineStart(CurPtr)+TheSetter._R.IndentLen;
If BufChar(P)=#32
then DeleteRange(P,NextChar(P),False);
end;
procedure TEditor.StartSelect(P : Word);
begin
Selecting := True;
SetSelect(P,SelEnd,True);
{$IFDEF SVISION}
UpdateFlags := UpdateFlags or ufBlock;
{$ENDIF}
end;
procedure TEditor.EndSelect(P : Word);
begin
Selecting := True;
SetSelect(SelStart,P,False);
{$IFDEF SVISION}
UpdateFlags := UpdateFlags or ufBlock;
{$ENDIF}
end;
procedure TEditor.Store(var S: TStream);
begin
inherited Store(S);
PutPeerViewPtr(S, HScrollBar);
PutPeerViewPtr(S, VScrollBar);
PutPeerViewPtr(S, Indicator);
S.Write(BufSize, SizeOf(Word));
S.Write(SCY,SizeOf(SCY));
end;
procedure TEditor.ToggleInsMode;
begin
Overwrite := not Overwrite;
SetState(sfCursorIns, not GetState(sfCursorIns));
end;
procedure TEditor.Tab;
var i : Byte;
S : String;
Begin
Lock;
S := '';
for i := 1 to (TheSetter._R.TabLen-(CurPos.X mod TheSetter._R.TabLen)) do
S := S + #32;
if (Ord(S[0])<>0) then
InsertText(@S[1],i,False);
TrackCursor(not CursorVisible);
UnLock;
end;
procedure TEditor.TrackCursor(Center: Boolean);
begin
if Center then
ScrollTo(CurPos.X - Size.X div SCX + 1, CurPos.Y - (Size.Y div SCY) div 2) else
ScrollTo(MaxLong(CurPos.X - Size.X div SCX + 1, MinLong(Delta.X, CurPos.X)),
MaxLong(CurPos.Y - Size.Y div SCY + 1, MinLong(Delta.Y, CurPos.Y)));
end;
procedure TEditor.Undo;
begin
{$IFDEF USE_UNDO}
SetNewStatus('Идет откат предыдущей операции...');
if UndoFile <> nil then begin
UndoFile^.Undo(@Self);
UpdateCommands;
end;
SetOldStatus;
{$ENDIF USE_UNDO}
end;
procedure TEditor.Unlock;
begin
if LockCount > 0 then
begin
Dec(LockCount);
if LockCount = 0 then DoUpdate;
end;
end;
procedure TEditor.Update(AFlags: Byte);
begin
UpdateFlags := UpdateFlags or AFlags;
if LockCount = 0 then DoUpdate;
end;
procedure TEditor.UpdateCommands;
begin
if not(IsClipboard) then
begin
SetCmdState(cmCut, HasSelection);
SetCmdState(cmCopy, HasSelection);
SetCmdState(cmPaste, (Clipboard <> nil) and (Clipboard^.HasSelection));
end;
SetCmdState(cmClear, HasSelection);
SetCmdState(cmPrint, True);
SetCmdState(cmFind, True);
SetCmdState(cmReplace, True);
SetCmdState(cmSearchAgain, True);
SetCmdState(cmSettings, True);
SetCmdState(cmFormat, True);
SetCmdState(cmFormatNew, True);
SetCmdState(cmFormatInt, True);
end;
function TEditor.Valid(Command: Word): Boolean;
begin
Valid := IsValid;
end;
{$I DIALOG.INC}
{$UNDEF FROM_EDITOR}
end. {Editor}
Там кстати и про
SuperVision упоминания есть.
А ещё была "штука" -"редактор шаблонных документов". До сих пор мной не повторённая.
Это когда часть текста - ReadOnly а часть - "поля для заполнения".
Типа "формы ввода".
https://sourceforge.net/p/rumtmarc/code-0/HEAD/tree/trunk/DOSEditors/OLD/LONGEDIT.PAS
Ну и "длинный буфер":
https://sourceforge.net/p/rumtmarc/code-0/HEAD/tree/trunk/DOSEditors/NEW/LONGBUF.PAS
Исходники иногда "рвут крышу" - типа "данные обращаются к View". Зато они сильно документированы. Я сейчас столько комментариев - не пишу. Даже удивительно, что уогда-то писал.
А вот тут:
https://sourceforge.net/p/rumtmarc/code-0/HEAD/tree/trunk/DOSEditors/wEditor/Editor/OE/ALTABLER.PAS
https://sourceforge.net/p/rumtmarc/code-0/HEAD/tree/trunk/DOSEditors/wEditor/Editor/OE/ALTABLER.INC
https://sourceforge.net/p/rumtmarc/code-0/HEAD/tree/trunk/DOSEditors/wEditor/Editor/OE/ALTABLEC.PAS
https://sourceforge.net/p/rumtmarc/code-0/HEAD/tree/trunk/DOSEditors/wEditor/Editor/OE/ALTABLEC.INC
Ещё смешнее - реализация таблиц для Plain-Text редактора.
unit alTableR;
interface
uses
OvcBase,
alEditN,
alPara,
alUndo,
alTableC,
alEditCo,
cChars;
type
TColumnArray = array [1..MaxColumnCount] of TTableColumn;
{=========================================================================}
type
TTableRow = class(TParaNode)
protected
{---------------------------------------------------------------------}
{ добавленные поля }
FColumnArray : TColumnArray;
FColumnCount : Integer;
FTableWidth : Integer;
FLeftDelta : Integer;
FTree : TParaList;
protected
{---------------------------------------------------------------------}
{ методы для работы со свойствами }
function GetColumnWidth(i: Integer) : Integer;
{ - возвращает ширину i-й колонки }
procedure SetColumnWidth(i: Integer; Value: Integer);
{ - устанавливает ширину i-й колонки }
procedure SetLeftDelta(Value: Integer);
{ - устанавливает отступ таблицы }
function GetColumn(i : Integer) : TTableColumn;
{ - возвращает i-ю колонку }
procedure SetColumn(i: Integer; Value: TTableColumn);
{ - присваивает i-ю колонку }
public
{---------------------------------------------------------------------}
{ переопределенные методы }
function NthLine(N : Integer; var Len : Word) : PChar;
override;
{-return a pointer to the Nth line of this paragraph; Len is its length}
procedure Recalc;
override;
{-calculate the number of lines in this paragraph given the specified
wrap column}
function PosToLine(Pos : Integer; var Col : Integer) : Integer;
override;
{-given a position in the paragraph, return the line and Col}
function PEQ(PN: TParaNode): Boolean;
override;
{-сравнивает параметры двух параграфов на идентичность}
function GetHIndent(L : Integer) : Integer;
override;
{-}
{---------------------------------------------------------------------}
{ переопределенные методы для записи/чтения строки таблицы }
procedure StoreParas(OnWrite: TalEditorReadWriteEvent; var Res: LongInt);
override;
{-сохраняет параметры строки таблицы}
constructor LoadParas(OnRead: TalEditorReadWriteEvent; var Res: LongInt);
override;
{-читает параметры строки таблицы}
procedure StoreText(Editor: TOvcBase; OnWrite: TalEditorReadWriteEvent; var Res : LongInt);
override;
{-сохраняет текст параграфа}
procedure LoadText(Editor: TOvcBase; OnRead: TalEditorReadWriteEvent; Count: LongInt;
var Res: LongInt);
override;
{-читает текст параграфа}
{---------------------------------------------------------------------}
{ добавленные методы }
constructor Create(aTree: TParaList; aColumnCount,
aLeftDelta, aTableWidth,aColumnWidth: Integer);
virtual;
{-создает новую строку таблицы не заполняя ее ячейками}
constructor CreateSame(aTree: TParaList; TR: TTableRow);
virtual;
{-создает строку таблицы с параметрами как у TR}
constructor CreateEmpty(aTree: TParaList; aColumnCount, aTableWidth: Integer);
virtual;
{-создает пустую строку таблицы заполнив ее ячейками}
destructor Destroy;
override;
{-}
function ScreenPosToTable(P : Integer; var TP: TTablePoint): TTableColumn;
{-из позиции на экране находит позицию в таблице }
function GlobalPosToTable(C: Integer; P : Integer) : Integer;
{ - из позиции на экране находит позицию в таблице }
procedure CorrectScreenPos(var CurLine : LongInt;
var CurCol : Integer;
var LinePos : Integer);
{-поправляет позицию на экране так
чтобы она правильно попадала в ячейку таблицы }
procedure MoveCaretToPP(C: Integer;
Para: LongInt; var Pos: Integer);
{ - из позиции в таблице - делает позицию на экране }
procedure MoveCaretTo(C: Integer;
Line: LongInt; var Col: Integer);
{-из позиции в таблице - делает позицию на экране }
function GetHighlightBorder(BC, EC: Integer;
var HBC, HEC: Integer) : Boolean;
{-определяет границы колонок которыми ограничено выделение }
procedure GetHighlightColumns(Left,Right: Integer;
var LeftColumn, RightColumn: Integer);
{-возвращает номера колонок выделенных в данной строке таблицы}
procedure InsertColumn(C: Integer);
{-вставляет новую колонку по номеру C}
procedure PlaceColumn(C: Integer; TC: TTableColumn);
{-вставляет новую колонку TC по номеру C}
procedure DeleteColumn(C: Integer);
{-удаляет колонку по номеру C}
procedure SwapColumns(C1,C2: Integer);
{-меняет колонки местами}
{---------------------------------------------------------------------}
{ свойства }
property Tree : TParaList
read FTree
write FTree;
{-дерево параграфов-владелец данной строки таблицы}
property Column [i : Integer] : TTableColumn
read GetColumn
write SetColumn;
default;
{- i-я ячеека }
property ColumnWidth [i : Integer] : Integer
read GetColumnWidth
write SetColumnWidth;
{-ширина i-й колонки }
property ColumnCount : Integer
read FColumnCount
write FColumnCount;
{-число колонок }
property TableWidth : Integer
read FTableWidth
write FTableWidth;
{-ширина таблицы }
property LeftDelta : Integer
read FLeftDelta
write SetLeftDelta;
{-левый отступ таблицы }
end; { TTableRow }
{=========================================================================}
implementation
uses
alEdit,
alParaT,
MinMax;
{$I altableR.inc }
end.
Я уж и забыл, что "такое было".
Под каким-нибудь
Lazarus'ом или Delphi1 это даже наверное соберётся.
