{******************************************************************
 ***                                                            ***
 ***              VARIOUS TEXT BLOCK HANDLING ROUTINES          ***
 *** M HILL                                               Jan 93***
 ******************************************************************}
{For "string extension" kind of inputlines, to small memo type notes such
as those for invoice notes, to letter editing techniques.  The last two
use the editor defined in the editor unit, they all use a similar technique
(defined here) fo storing the text.}
{set wrapwidth to
	-1 - for forms, etc, where no width is given but paragraph markers are required
	 0 - to disable paragraph markers
	 nn - width to wrap at}


{$I compdirs}
unit notes;

INTERFACE

uses drivers, objects,
			linklist,{}
		 global, files,
{$IFDEF WINDOWS}
	wui,	{windows}
{$ELSE}
	tui,views, tuiedit, {text}
{$ENDIF}
			forms,
			lstrings,
		 editor;

{======== Extended TMemo (eg word wrap) ==========}
{also expects TTextData as its corresponding get/setdata data}
type
	PInputFreeText = ^TInputFreeText;
	TInputFreeText = object(TMemo)
		GoString : string; {mostly for the <BEGIN> of letters - positions here after getdata}
		WrapWidth : integer;
		constructor Init(var Bounds : TRect; ABufSize : word; AWrapWidth : integer; AIndicator : PIndicator);
		destructor Done; virtual;
		procedure DeleteRangeAt(StartP, EndP : word);
		procedure InsertAt(P : word; S : string);
		procedure AppendStr(S : String);
		function EndWord(Ptr : word) : word;
		function LineLength(P : word) : word;
		procedure INsertFile;

		procedure Wrap(Ptr : word);
		procedure HandleEvent(var Event : TEvent); virtual;
		function Valid(Command: Word): Boolean; virtual;

		procedure SetData(var Rec); virtual;
		procedure GetData(var Rec); virtual;
		function  DataSize : word; virtual;
	end;

	{Expects PFreeTextData as Rec, but acts like an ordinary input line
	 - For writing comments, up to 255chars}
	{useful when ordinary inputline wanted but stored in the extra text file}
	PInputString = ^TInputString;
	TInputString = object(TInputELine)
		constructor Init(Bounds : TRect);
		procedure SetData(var Rec); virtual;
		procedure GetData(var Rec); virtual;
		function DataSize : word; virtual;
	end;


{========= DATA TYPE ======================}
{TFreeTextData provides a file-storeable shell to the longstring record (see
	lstrings unit}

	{--- Parent type ---}
	PFreeTextData = ^TFreeTextData;
	TFreeTextData = object(TObject)
			Loaded   : boolean;    {Flag to say whether buffer loaded}
			First    : longint;    {Pointer to first text chain record}
			fiType   : word;
			Text     : TLongString;  {pointer to something of the format TMemoData or TNoteData, etc as above}

		constructor Init;
		destructor Done; virtual;

		procedure  Load(var S : TStream); {loads just odd details, direct from "owners" stream}
		procedure  LoadText; virtual; {loads text itself from text file}
		procedure  Store(var S : TStream); virtual; {stores both above details and text (if text loaded)}
	end;

	{---- Letter Data  -----}
	PLetterData = ^TLetterData;
	TLetterData = object(TFreeTextData)
		constructor Init; {different fitype}
	end;


{======= CHAIN FILE TEXT STOREAGE ===================}
type
	PTextStream = ^TTextStream;
	TTextStream = object(TChainStream)
		function Get : PObject; virtual;    {Overriders that don't get VMT}
		procedure Put(P : PObject); virtual;
	end;

const
	TLetterItemSize = 256;
	TNoteItemSize   = 64;


{TEXT ITEM - used to store chains of "string extensions"}
{TNode is a bit overkill, but it will work quite happily here}
type
	PTextItem = ^TTextItem;
	TTextItem = object(TNode)
		 Data : string;
		 ItemSize : word;
		 Procedure Load(var S : TDataStream);
		 procedure Store(var S : TDataStream);
	end;

{ const
	 {--- Required for Stream ----}
{	 RTextItem : TStreamRec = (
		 ObjType : srTextItem;
		 VmtLink : Ofs(TypeOf(TTextItem)^);
		 Load : @TTextItem.Load;
		 Store : @TTextItem.Store
	 );
{}

	{Free text code}
	PFreeTextFormCode = ^TFreeTextFormCode;
	TFreeTextFormCode = object(TFormCode)
		FreeText : TFreeTextData;
		constructor Init(const NCOde : string; NFreeTExt : TFreeTextData);
		destructor Done; virtual;
		function Replace(const SubCode, Param : TFCodeStr; const FormCodes : PFormCodeCollection;
																													var LString : TLongString) : boolean; virtual;
	end;


IMPLEMENTATION

uses
			{$IFNDEF SingleUser} muser, {$ENDIF} {check locks}
			tasks,
			tuiboxes, editfile, {for inserting a file}
			help,
			stddlg,
			messtext,
			tuimsgs,  minilib;

{========= FREE TEXT ===========}
constructor TFreeTextFormCode.Init;
begin
	inherited Init(NCode);
	FreeText.Init;
	FreeText.fiType := NFreeText.fiType;
	FreeText.First := NFreeText.First;
	LSSetLen(FreeText.Text, LSLen(NFreeText.Text));
	FreeText.Loaded := False;
end;

destructor TFreeTextFormCode.Done;
begin
	FreeTExt.Done;
	inherited Done;
end;

function TFreeTextFormCode.Replace;
begin
	Replace := True;
	if not FreeTExt.Loaded then FreeText.LoadText;
	LSReWidth(FreeText.Text, 0); {reformat with no soft returns}
	LSClear(LString);
	LSAppend(LString, FreeText.Text);
end;


{********************************************
 ***                                      ***
 ***           INPUT TEXT                 ***
 ***              Extended Editor         ***
 ********************************************}
{Descendant of Memo Box}

constructor TInputFreeText.Init;
begin
	inherited Init(Bounds, nil, nil, AIndicator, ABufSize);

	if not isValid then begin
		{not been able to create properly - probably due to lack of memory}
		{don't fail - that would cause setdata mismatch problems.  Just set
		to non-selectable}
		ProgramWarning('Running VERY low on memory'#13#10'Dialog Box not formed properly. Cancel.',hcMemoryLowMsg);
		SetState(sfDisabled, True);
	end;

	{Create vertical scroll bar & position - caller will have to insert}
	Bounds.A.X := Bounds.B.X-1;
	Bounds.Move(1,0);
	New(VScrollBar, INit(Bounds));

	WrapWidth := AWrapWidth;
	GoString := '';
end;

destructor TInputFreeText.Done;
begin
	{if not inserted into view, dispose of scroll bar.  (If it is, owning group will dispose)}
	if VScrollBar^.Owner = nil then dispose(VScrollBar, done);
	inherited Done;
end;

{******************************************
 ***          WORD WRAPPING             ***
 ******************************************}
function TInputFreeText.LineLength(P : word) : word;
var LineEndPos, LineStartPos : word;
begin
	LineEndPos := LineEnd(P);
	LineStartPos := LineStart(P);
	LineLength := LineEndPos - LineStartPos;
end;     {}


procedure TInputFreeText.InsertAt(P : word; S : string);
var OldCurPtr : integer;
begin
	OldCurPtr := CurPtr;
	SetCurPtr(P, 0);
	InsertText(@S[1], length(S), False);

	{reposition}
	if OldCurPtr<=P then
		SetCurPtr(OldCurPtr, 0)
	else
		SetCurPtr(OldCurPtr + length(S), 0);
end;

procedure TInputFreeText.AppendStr(S : string);
begin
	InsertAt(BufLen, S);
end;

procedure TInputFreeText.DeleteRangeAt(StartP, EndP : word);
var OldCurPtr : integer;
begin
	if (StartP<CurPtr) and (EndP>CurPtr) then
		{just do ordinary delete}
		DeleteRange(StartP, EndP, False)
	else begin
		OldCurPtr := CurPtr;
		SetCurPtr(StartP,0);
		DeleteRange(StartP, EndP, False);
		if EndP<oldCurPtr then
			{deleted area was before cursor}
			SetCurPtr(OldCurPtr - (EndP - StartP), 0)
		else
			SetCurPtr(OldCurPtr, 0);
	end;

end;

{locates end of word - returns pointer to character *after* word}
function TInputFreeText.EndWord(Ptr : word) : word;
begin
	while (Ptr<Buflen) and (BufChar(Ptr)<>' ') and (BufChar(Ptr)<>EndParaChar) and
		(BUfChar(Ptr)<>#13) do Ptr := NextChar(Ptr);
	EndWord := Ptr;
end;



{wraps from current line}
procedure TInputFreeText.Wrap(Ptr : word);
var	PrevWordPos, NextWordPos, LineStartPos, LineEndPos,
			NextLinePos, WordSize : integer;

begin
	if WrapWidth <= 0 then exit; {no word wrapping}

	Owner^.lock;{}

	{check this line}

	{find end, but ignoring last spaces}
{	LineEndPos := LineEnd(Ptr);
	LineStartPos := LineStart(Ptr);
	while (LineEndPos>LineStartPos) and (BufChar(LineEndPos)=' ') do LineEndPos := PrevChar(LineEndPos);{}

	if LineEnd(Ptr)-LineStart(Ptr)>WrapWidth then begin {line too long}
		PrevWordPos := LineEnd(Ptr); {start at end of line}

		{locate first word that *starts* within width}
		while (PrevWordPos - LineStart(PrevWordPos))>WrapWidth do PrevWordPos := PrevWord(PrevWordPos);

		{check to see if word goes over end of line}
		if (EndWord(PrevWordPos)-LineStart(PrevWordPos))>WrapWidth then begin
			{insert new line before word}
			if PrevWordPos<>LIneStart(Ptr) then begin
				InsertAt(PrevWordPos, CRLF); {if not one long word...}
				Wrap(NextWord(PrevWordPos));
			end;
		end else begin

			{insert new line after word}
			if NextWord(PrevWordPos)<LineEnd(PrevWordPos) then begin{next word on line}
				InsertAt(NextWord(PrevWordPos), CRLF);
				Wrap(NextWord(PrevWordPos)); {wrap next line}
			end;
		end;

	end else begin
		{line fits OK - if it has a soft return at the end (ie no end para
		marker) and it's not the last line in the file, check if at least part of the
		following line can fit (by deleting soft return and re-wrapping)}
		NextLinePos := NextLine(Ptr);
		LineEndPos := LineEnd(Ptr);
		if (NextLine(Ptr)<>LineEnd(Ptr)) and (BufChar(LineEnd(Ptr)-1)<>EndParaChar) then begin {not an end of paragraph marker}

			{if next line is empty (end of buffer) or has just end-para marker, then
			just remove soft return}
			if (NextLine(ptr)=BufLen) or (BufChar(NextLine(Ptr))=EndParaChar) then begin
				{end para marker right after soft return, so just delete soft return}
				DeleteRangeAt(LineEnd(Ptr), NextLine(Ptr));
			end else{} begin
				NextWordPos := NextWord(LineEnd(Ptr)); {beginning of next word}
				{find end of next word}
				WordSize := EndWord(NextWordPos)-NextWordPos;

				if (WordSize+LineLength(Ptr))<WrapWidth then begin
					{it will fit, so lets delete between the end of the line and the beginning
					of the word, adding a space}
					LineEndPos := LineEnd(Ptr);
					DeleteRangeAt(LineEndPos, NextWordPos);

					if BufChar(LineEndPos-1)<>' ' then InsertAt(LineEndPos, ' ');
					Wrap(Ptr); {rewrap as this line is probably now too long}
				end else
					{ok, so it won't fit but it's a soft return, so go on to check next line}
					Wrap(NextLine(Ptr));
			end;
		end;
	end;

	TrackCursor(False);{}
	if (Delta.X<>0) and ((Delta.X+CurPos.X)<Size.X) then ScrollTo(0,Delta.Y); {irritating to have the first few chars missing}

	Owner^.unlock;{}
end;

{******************************************
 ***          INSERT FILE               ***
 ******************************************}
procedure TInputFreeText.InsertFile;
var Control : Word;
		FIleName : FNameStr;
		InsFIle : text;
		S : string;
		LastIOResult : integer;

begin
	FileName := '';

	Control := FileSelectBox('Insert File', 'Name',FileName, '','', fdAcceptButton+fdFullPath, hcNoContext);

	if Control=cmAccept then begin
		ThinkingOn('Reading file');
		Assign(InsFile, FileName);
		{$I-}
		Reset(InsFIle); LastIOResult := IOResult;
		{$I+}
		if LastIOResult=0 then begin
			while not eof(InsFile) do begin
				Readln(InsFile, S);

				if (WrapWidth<>0) then
					if (WrapWidth=-1) or (length(S)<WrapWidth-10) then S := S + EndParaChar;

				InsertText(@S[1], length(S), False);
				S := CRLF;
				InsertTExt(@S[1], 2, False);
			end;
			CLose(InsFile);
		end else begin
			ProgramWarning('Could not open '+FileName+#13#10
												+IOError(LastIOResult),
												hcIOErrorMsg);
		end;
		ThinkingOff;
	end;

	TrackCursor(False);
end;




{***************************************
 **      HANDLE EVENT                ***
 ***************************************}
{Adds Word Wrap}
procedure TInputFreeText.HandleEvent;
var OldEvent : Tevent;
		Control : Word;
		FullFileName : string;
begin
	OldEvent := Event; {for post checking below}
	if (Event.What = evKeyboard) then begin

		if (WrapWidth>0) then begin
			{force wrap}
			if (Event.KeyCode = kbCtrlB) then begin
				Wrap(CurPtr);
				ClearEvent(Event);
			end;
		end;

		if WrapWidth<>0 then begin
			{hard return - allowed if wrapwidth set to -1}
			if (Event.KeyCode = kbEnter) then begin
				InsertAt(CurPtr, EndParaChar);
				SetCurPtr(NextChar(CurPtr),0); {move on to after marker}
			end;
		end;


		{Ctrl Backspace --> Ctrl-T}
		if (Event.KeyCOde = kbCtrlBack) then
			Event.KeyCOde := GetCtrlCOde('T');

	end;

	if (Event.What=evCommand) and (Event.Command = cmSoftReturn) then begin
		Event.What := evKeyBoard;
		Event.KeyCode := kbEnter;
	end;

	inherited HandleEvent(Event);

	{loadfile}
	if (Event.What=evCommand) and (Event.Command=cmLoadFile) then begin
{		Control:= InputFNameBox('File to Read', FullFileName, '',FormsPath, FileEditor);{}
		InsertFile;
	end;



	{post checking for wrapping}
	if (OldEvent.What = evKeyBoard) and (WrapWidth>0) then begin

		{{$IFDEF MSDOS}
			{for older systems, just check if cursor is over end}
		{	if (OldEvent.KeyCode<>kbBack) and (CurPos.X>WrapWidth) then Wrap(CurPtr);{}
		{{$ELSE}
			{Check for word wrap as typing, but not deleting}
			{may be backspacing prev line onto this one}
			if (OldEvent.KeyCode<>kbBack) and (LineLength(CurPtr)>WrapWidth) then Wrap(CurPtr);{}
		{{$ENDIF}

		{Handling end of paragraph marker}
		{This is so that you can't type after the marker.  Shouldn't matter
			but easier for user if he/she doesn't have to worry about it}
		if (CurPtr>0) and (BufChar(CurPtr-1)=EndParaChar) then
			case OldEvent.KeyCode of

				{Backspace - deleted crlf to land next to endparachar}
				kbBack : Message(@Self, evKeyBoard, kbBack, nil); {do it again}

				{cursor movements - skip over marker}
				kbUp, kbEnd, kbDown, kbLeft, kbPgUp, kbPgDn : SetCurPtr(PrevChar(CurPtr),0);

				{moved right over marker - move on to next line}
				kbRight :	SetCurPtr(NextChar(CurPtr),0);
			end;

	end;


end;



function TInputFreeText.Valid;
begin
	{inherited method just sets to isvalid - we want to allow cancel
	to work}
	if Command = cmCancel then Valid := True
	else Valid := inherited Valid(Command);
end;

procedure TInputFreeText.SetData;
var GoPos : word;
begin
	{check that editor buffer size is big enough to take in associated TFreeTextData's buffer}
	if PFreeTextData(Rec)^.Text.Length>BufSize then begin
		FreeMem(Buffer, BufSize);
		BufSize := PFreeTextData(Rec)^.Text.MemSize;
		GetMem(Buffer, BufSize);
	end;

	if not PFreeTextData(Rec)^.Loaded then PFreeTextData(Rec)^.LoadText;

	if WrapWidth>0 then begin
		if GoString<>'' then GoPos := LSPos(GoString, PFreeTextData(Rec)^.Text) else GoPos := 0;
		LSReWidthFrom(PFreeTextData(Rec)^.Text, WrapWidth, GoPos);
	end;

	{put data into *end* of editor buffer, ie gap at beginning}
	Move(PFreeTextData(Rec)^.Text.Data[0], Buffer^[BufSize - PFreeTextData(Rec)^.Text.Length],
														PFreeTextData(Rec)^.Text.Length);

	SetBufLen(PFreeTextData(Rec)^.Text.Length); {do after above so limits are recalced}

	if GoString<>'' then begin
		Search(GoString, 0);    {Move to end of <BEGIN>}
		Search('',0);     {Find the next bit of nothing - switches off selection of above}
	end;
end;

procedure TInputFreeText.GetData;
begin
	{Check that associated TFreeTextData buffer size is big enough to take editor buffer}
	if PFreeTextData(Rec)^.Text.MemSize<BufSize then
		LSExpand(PFreeTextData(Rec)^.Text, BufSize);

	{get data into length & buffer}
	LSSetLen(PFreeTextData(Rec)^.Text, BufLen);

	{get data from before and after cursor gap}
	Move(Buffer^, PFreeTextData(Rec)^.Text.Data[0], CurPtr);
	Move(Buffer^[CurPtr + GapLen], PFreeTextData(Rec)^.Text.Data[CurPtr], BufLen - CurPtr);
	FillChar(PFreeTextData(Rec)^.Text.Data[BufLen], BufSize - BufLen, 0);
end;

function TInputFreeText.DataSize;
begin DataSize := sizeof(PFreeTextData); end;

{************************************
 ***     INPUT STRING/COMMENT DESCENDANT  ***
 ************************************}
constructor TINputString.Init(Bounds : Trect);
begin
	inherited Init(Bounds, 255);
end;

procedure TInputString.SetData;
begin
	Data^[0] := char(PFreeTextData(Rec)^.Text.Length and $FF);
	Move(PFreeTextData(Rec)^.Text.Data[0], Data^[1], 255);
end;

procedure TInputString.GetData;
begin
	PFreeTextData(Rec)^.Text.Length := ord(Data^[0]);
	Move(Data^[1], PFreeTextData(Rec)^.Text.Data[0], 255);
end;

function TINputString.DataSize;
begin DataSize := sizeof(PFreeTextData); end;



{**********************************************
 ***                                        ***
 ***             TEXT STORAGE               ***
 ***                                        ***
 **********************************************}

{****************************************
 ***     TEXT FILE                    ***
 ****************************************}
{As chain file, but assumes text item will be loaded/stored - no VMT check}

function TTextStream.Get;
var TextItem : PTextItem;
begin
	New(TextItem, init);
	TextItem^.ItemSize := RecSize;
	TextItem^.Load(Self);
	Get := TextItem;
end;

procedure TTextStream.Put;
begin
	PTextItem(P)^.ItemSize := RecSize;
	PTextItem(P)^.Store(Self);
end;

function NewNotesTextStream : PStream; far;
begin
	{mostly sequential reads/writes, but may be just one record size in length...}
	NewNotesTextStream := New(PTextStream, init('NOTES.DAT',TNoteItemSize, TNoteItemSize));
end;

function NewLetterTextStream : PStream; far;
begin
	{likely to be several sequential read/writes}
	NewLetterTextStream := New(PTextStream, init('LETTERS.DAT',TLetterItemSize, 4096));
end;

	{**************************************
	 *** TEXT BLOCK STORAGE OBJECT      ***
	 **************************************}

{==== FOR STORING THE TEXT IN A SEPARATE FILE ======}
{THESE ARE MEANT TO BE READ/WRITTEN DIRECTLY TO FILE, NOT VIA STD PUT/GET
 - SAVES VMT SPACE, ALLOWS LOAD TO USE READFIXEDSTR (DATASIZE SET BEFOREHAND)}

	procedure TTextItem.Load;
	begin
		S.Read(NextID, 4);
		Data := S.ReadFixedStr(ItemSize-4);
	end;

	procedure TTextItem.Store;
	begin
		S.Write(NextID, 4);
		Data := PadNulR(Data,ItemSize-4);  {Pad with nuls}
		S.WriteFixedStr(@Data, ItemSize-4);
	end;


	{**************************************
	 *** TEXT EDIT OBJECT               ***
	 **************************************}
{Edited via above TInputFreeText object}
{Stores itself in separate extension text file}
	constructor TFreeTextData.Init;
	begin
		inherited Init;
		LSNew(Text);
		First := -1;
		Loaded := True;    {When set up for the first time, there is nothing to load}
		fiType := fiNoteText; {descendants should override if nec}
	end;

	destructor TFreeTextData.Done;
	begin
		LSDispose(Text);
		inherited Done;
	end;

	{============ LOAD TEXT FROM TEXT DATA FILE ==============}
	procedure TFreeTextData.Load;
	var W : word;
	begin
		S.Read(W, 2);
		LSSetLen(Text, W);                       {Write length of buffer...}
		S.Read(First, 4);                                 {...and pointer to pos in text file}
		Loaded := False;                                  {Not loaded yet}
	end;


	{Run this separately on edit/print}
	procedure TFreeTextData.LoadText;
	var TextItem : PTextItem;
			I,BufPos,RecNo : longint;
			TextStream : PTextStream; {shorthand access to fileptr}

	begin
		Loaded := True;             		{Mark as buffer is loaded}
		if First = -1 then exit; 				{don't bother - nothing there}

{		ThinkingOn('Loading Text'); not really needed any more now it's faster}
{		if CheckFileLock(fiType, 'Loading Text'#13#10'Text Data File')>0 then exit;             {in use, o/w set}
{		SetFileLock(fiType, True); {locking not important when loading?}

		FileAdmin(fiType)^.LogOn;
		TextStream := PTextStream(FileAdmin(fiType)^.FilePtr);
		RecNo := First;                                      {First in chain}

		{Read in chunks}
		BufPos :=0;
		while (BufPos<=Text.Length) and (RecNo<>-1) and (TextItem<>nil) do begin
			TextItem := PTextItem(TextStream^.GetAt(RecNo));

			if TextItem = nil then
				DBaseMessage(TextStream,'Cannot retrieve text item '+N2Str(RecNo),mfError,hcInternalErrorMsg)
			else begin
				{copy textitem text to self}
				LSOverwriteStr(Text, TextItem^.Data, BufPos);
				BufPos := BufPos + length(TextItem^.Data);

				RecNo := TextItem^.NextID;
				dispose(TextItem, done);
			end;
		end;

		{check for errors.  Really want to present a choice - truncate or append.  Leave to KFIXIT}
		if (RecNo<>-1) and (TextItem<>nil) then begin
			DBaseMessage(TextStream, 'More text chain but none expected'#13#10'Truncating', mfError,hcInternalErrorMsg);{}
{      TextItem := PTextItem(TextStream^.GetAt(OldRec));
			TextItem^.Next := -1;
			TextStream^.PutAt(OldRec, TextItem);
			dispose(textItem, done);{}
		end;

		if BufPos<Text.Length then begin
			DBaseMessage(TextStream,'Text chain ends but more expected'#13#10'Resetting length',mfError,hcInternalErrorMsg);
			LSSetLen(Text, BufPos);
		end;

		FileAdmin(fiType)^.LogOff;
{		SetFileLock(fiType, False); {clear lock}
{		ThinkingOff;{}
	end;

	{========== STORE TEXT IN TEXT DATA FILE =================}
	procedure TFreeTextData.Store;
	var I, TextItemLength : integer;
			BufPos : word;
			RecNo : longint;
			TextItem : PTextItem;
			TextStream : PTextStream; {shorthand access to FilePtr}

	begin
		if not loaded then begin
			{if not loaded, then just re-write pointers to S and exit}
			BufPos := Text.Length;
			S.Write(BufPos,2);
			S.Write(First,4);
			exit;
		end;

		{Special case of nothing entered.  Works perfectly well below but
		this quick check prevents file locking, unlocking, opening, thinking
		boxes, etc}
		if Text.Length = 0 then begin
			BufPos := 0; 	S.Write(BufPos,2);
			First := -1; 	S.Write(First, 4);
			exit;
		end;

{		ThinkingOn('Storing Text'); faster now, no need for message}
		{Check lock status of text data file}
		{$IFNDEF SingleUser}
		if CheckFileLock(fiType,'Text Data File'#13#10'Storing Text')>0 then begin  {Check lock on file, returns >0 if cancel}
			{cancel - clear it all}
			LSClear(Text);
			First := -1;
			BufPos := Text.Length;
			S.Write(BufPos, 2);
			S.Write(First,4);
			exit;
		end;

		SetFileLock(fiType, True);
		{$ENDIF}

		{Open text file}
		FileAdmin(fiType)^.LogOn;
		TextStream := PTextStream(FileAdmin(fiType)^.FilePtr);

		if First = -1     then First := TextStream^.NoRecs;      {If new, set to end of file}
		if Text.Length = 0 then First := -1;           {Special case of nothing to write}

		{Write to "owners" stream}
		BufPos := Text.Length;
		S.Write(BufPos, 2);               {Write length of buffer...}
		S.Write(First, 4);                            {...and pointer to pos in text file}

		{--Break up memodata text into blocks & write--}
		{Initialise}
		New(TextItem, init);
		TextItem^.ItemSize := TextStream^.RecSize;
		TextItem^.Data := '';
		TextItem^.NextID := -1;
		BufPos := 0;
		RecNo := First;
		TextItemLength := TextStream^.RecSize-4;

		while BufPos<=Text.Length do begin
			TextItem^.Data := LSGetString(Text, BufPos, TextItemLength);
			TextItem^.NextID := -1;      {Clear}
			BufPos := BufPos+TextItemLength; {length(TextItem^.Data);{?}

			{Locate where next one will go}
			TextStream^.PutNext(RecNo, TextItem, BufPos<=Text.Length); {RecNo is set to next position to put}
		end;

		{Close down}
		Dispose(TextItem, done);
		FileAdmin(fiType)^.LogOff;

		{$IFNDEF SingleUser}
		SetFileLock(fiType, False); {clear}
		{$ENDIF}
{		ThinkingOff;{}
	end;


{*******************************
 ***     LETTER DATA         ***
 *******************************}
	constructor TLetterData.Init;
	begin
		inherited init;
		fiType := fiLetterText;
	end;


begin
	NewFileAdmin(fiNoteText, 'Notes Text Stream',NewNotesTextStream);
	NewFileAdmin(fiLetterText, 'Letter Text Stream',NewLetterTextStream);

{	FileAdmin[fiNoteText]^.LogOn;
	FileAdmin[fiLetterText]^.LogOn;{}
end.
