{****************************************************************************
 ***                                                                      ***
 *** New Fabbo Singing Dancing OOP                                        ***
 ***                          D I R E C T O R Y                           ***
 ***                                                                      ***
 *** M Hill                                                               ***
 ****************************************************************************}
{The directoryitem provides a parent to all customers, suppliers, companies, etc
that will appear in a main directory index, so that no matter how everyone
gets broken down, they are still available from one main directory}
{$I compdirs}  {Compiler directives}

unit KDIRCTRY;

INTERFACE

uses 	objects, scodes, dattime, files, global,
			tuilist, tasks,
			devices, {for labels}
			jimmys, jimindxs,
			inpjimmy,
			tuiedit,
			address,
			lstrings,
			forms,
{$IFDEF WINDOWS}
	wui,	{windows}
{$ELSE}
	tui,views,dialogs,
			menus, {for dialling}
{$ENDIF}
		 drivers;


{**************************************
 ***         DIRECTORY ITEM         ***
 **************************************}

const
	{Hook types}
{	hkMore = 1; {more-about list}
{now in global	hkHistory = 2; {history}
	hkAddress = 3; {alternative addresses}
	hkContacts = 4;
	hkAccounts = 5;

{	TDirectoryItemSize =  30;  {make room for pointers below - now replaced with recsize}
	TDirectoryIndexSize = 80;
	DirNameIdxTab = 30;

{	ixDirMax = 8; {number of ixtypes to run through when storing index}
type
	PDirectoryItem = ^TDirectoryItem;
	TDirectoryItem = object(TJimmy)

		ArchiveIdx : longint;				{File pointer, if deleted, to index item in archive index stream}
		Dat2Idx : longint;						{File Pointer to standard index item}
		AliasIdx : longint;					{File Pointer to alias index item}
		CategoryIdx : array [1..5] of longint;				{File pointer to index item in category index stream}

		Ptr2More : longint;           {Pointer to Extra Details Chain - eg computers owned}
		Ptr2History : longint;           {Pointer to History Chain}
		Ptr2Addresses : longint;			{pointer to alternative addresses}
		Ptr2Contacts : longint;
		Ptr2Accounts : longint;

		AddressID : longint; {pointer to current/default address}
		Address : PAddress;  {work address}

		DOReg   : TDate;              {Date of registration}

		{-- Methods --}
		constructor Init;
		procedure CommonInit; virtual;
		destructor Done; virtual;

		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;

		{Database stuff}
		function RecSize : word; virtual;
		constructor Load(var S : TDataStream);
		procedure   StoreFields(var S : TDataSTream); virtual;
		procedure OnStoreing(const DiskJImmy : PJimmy); virtual;    {extra storing method, done by storeself}

		{for fixit, etc}
		function NumIDs : byte; virtual; {the number of jimmy ID ptrs in the data}
		function GetJimmyID(const jiType : byte) : PLongint; virtual; {each jimmy ID}

		{--- Indexing -----}
		function NumixTypes : byte; virtual;
		procedure GetIndex(const ixType : byte; var IdxRec : Plongint; var fiType : byte); virtual;
		function GotByAlias(const fiType : byte) : boolean; virtual;

		{--- Hooking on others -----}
		function NumhkTypes : byte; virtual;
		procedure GetHookOn(const hkType : byte; var HookRec : PLongint); virtual;

		{Processing stuff}
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;
		function Edit(const Caller, AcceptorView : PView) : word; virtual;

		procedure Dial(LineNo : byte);

		{Methods returning important fields}
		function GetName(naType : byte; Maxlen : integer) : string; virtual;
		function GetTelNum(L : integer) : string; virtual;
		function GetFaxNum : string; virtual;
		function GetCategories : string; virtual;
		function GetContactFor : longint; virtual; {ie contact for/department for}
		function GetInvTo : longint; virtual;
		function Getemail : PAddress;  {Get email address}

		function GetAddress : PAddress; {loads default address}
		procedure ClearAddress; {dispose & nil default add}
		function GetAddressFor(Date : TDate; apType : word) : PADdress;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		procedure PrintLabel(const Device : PDeviceStream; LabelAs : word); virtual;
		procedure PrintLine(const Device : PDeviceStream); virtual;
		procedure PrintSummary(const Device : PDeviceStream; const PrintAs : word); virtual;
		procedure PrintFull(const Device : PDeviceStream; const PrintAs : word); virtual;
end;


{**************************************
 ***             LIST VIEWS         ***
 **************************************}

const
	{DirectoryItem views in list}
	dvNone    = $00;  {Just name}
	dvAddr    = $01;  {Name & town & postcode}
	dvTelPostc= $02;  {Tel No & postcode}
	dvTelAddr = $03;  {Tel no & town}
	dvSerComm = $04;  {Search/Comment Line}
	dvCrammed = $05;  {Crammed tel no, postcode bit & search codes}
	dvTelOnly	= $06;	{Tel only, for narrow views}

type
	{--- LIST INTERIOR ---}
	PDirectoryListView   = ^TDirectoryListView;          {Interior}
	TDirectoryListView   = object(TIndexedJimmyListView)

		constructor Init(var Bounds: TRect; const Nlstype,NfiType : byte; NCat : string);

		procedure HandleEvent(var Event : TEvent); virtual;
		procedure SetTabs; virtual;

		procedure DoLabel(const Command : word);
		procedure PrintEach(const TaggedOnly : boolean); virtual;
		procedure TagSelected;
	end;


type
	PDirectoryListSetup = ^TDirectoryListSetup;
	TDirectoryListSetup = object(TListSetup)

		procedure Load; virtual;
		procedure Store; virtual;
		procedure AddSetupLines(EditBox : PEditBox); virtual;
	end;


procedure MergeDirectoryItems;


{========= EXTENDED SCODES ==================}
{Make available to other modules - eg invoicing/products for price banding}
type
	PDirCatScodeItem = ^TDirCatScodeItem;
	TDirCatScodeItem = object(TScodeItem)
		Margin : integer;
		constructor Init(const NCode, NDesc : string; NMargin : longint);
		constructor Load(var S : TDataStream);
		procedure Store(var S : TDataStream); virtual;
		function DisplayLine(Maxlen : integer) : string; virtual;
		function Print(Device : PDeviceStream; prType : word) : word; virtual;
		procedure AddEditFields(P : PObjectEditBox);           virtual;
	end;

	PInputDirectory = ^TInputDirectory;
	TInputDirectory = object(TInputIndexedJimmy)

		constructor Init(var Bounds : TRect;
											const NFieldLen : integer;
											const NfiType, NlsType : word; const NSubIndexString : string);
		function CreateList(Bounds : TRect) : PListWindow; virtual;
		function SearchOn : string; virtual;
		function SuperSearchOn : string; virtual;
	end;

	{for codes/reports}
	{inherited ID & Jimmy point to the address list owner}
	PAddressFormCode = ^TAddressFormCode;
	TAddressFormCode = object(TJimmyFormCode)
		apType : word;
		ForDate : TDate;
		LastAddress : PAddress;
		constructor Init(const NCode : TFCodeStr; const NOwnerID : longint; const NapType : word; const NDate : TDate);
		destructor Done; virtual;
		function Replace(const SubCode, Param : TFCodeStr; const FormCodes : PFormCodeCollection;
																													var LString : TLongString) : boolean; virtual;
	end;

{see kdirsetuconst
	OftenCode : array[1..3] of TSCode = ('CUS','SUP','PRO');{}

procedure StartDirectoryList;

{***************************************************************************
 ***                 IMPLEMENTATION                                      ***
 ***************************************************************************}
IMPLEMENTATION

uses
		 labels, {for labels}
		 jimhooks, {for printing more about list and finding alt addresses}
		 minilib, app, printers,
			country, {for country scodes}
			tuiapp, tuijimmy,
			help,
			inplist, {for inputdirectory}
			kamsetup,
			dbg,
			tuimsgs,
			kperson, kcompany, {for addresses....}
			jimprint, inpfname, {$IFDEF kwplink} kwplink, {$ENDIF} editfile, kletter, {for printing list/mailshots}
			modems, {for dialling from list}
		 linklist, {for address tree printing}
		 kdirrpts,
		 kdirsetu,
		 inpdnt;

{***************************************************************************
 ***                 ADDRESS FORM CODES                                  ***
 ***************************************************************************}
{See forms unit - this object is tied to a particular
string in a form (Code), and the replace method is
called when that code is encountered.  Based on the
JimmyFormCode, the jimmy concerned is considered to be
the addresses *owner*.  The various parameters may require different
addresses, depending on dates, requirements, etc, but to save on loading
the same address again and again if it is required consecutively, this
object stores the last address gotten and re-uses that
if called with the same parameters.
The original setter of the code (eg TLetter) must specify the date for
the address (even if blank for any) and the type if requred, though the
type can be overriden in the letter with a parameter /}
constructor TAddressFormCode.Init;
begin
	inherited Init(NCode, NOwnerID);
	apType := NapType;
	ForDate.SetToDate(NDate);
	LastAddress := nil;
end;

destructor TAddressFormCode.Done;
begin
	if LastAddress<>nil then dispose(LastAddress, done);
	inherited Done;
end;

function TAddressFormCode.Replace;
var	WorkapType : word;
		WorkDate : TDate;
		Line : byte;

		function Valid(A : PAddress) : boolean;
		begin
			Valid := A^.ForDates.inRange(WorkDate) and ((A^.apType and WorkapType)<>0);
		end;


begin
	Replace := false; {not decoded yet}

	{get address list owner}
	if Jimmy= nil then Jimmy := GetJimmy(ID);

	if Jimmy= nil then begin
		Debug.Writeln('Could not get jimmy for addressformcode.replace...');
		exit; {hmmmm}
	end;

	{type of address}
	WorkapType := apType; {default to specified at setcode time}
	if Pos('/ANY',Param)>0 then WorkapType := apAny; {override}
	if Pos('/LTR',Param)>0 then WorkapType := apCorrespondence; {override}
	if Pos('/INV',Param)>0 then WorkapType := apInvoice;
	if Pos('/DEL',Param)>0 then WorkapType := apDelivery;
	if Pos('/HME',Param)>0 then WorkapType := apHome;
	if Pos('/WRK',Param)>0 then WorkapType := apWork;

	{for date}
	WorkDate.SetToDate(ForDate); {no overriding yet}

	if (LastAddress = nil) or not Valid(LastAddress) then begin
		{address required this time is not the same as the one got last
		time for this code, so dispose of LastAddress and reget}
		if LastAddress<>nil then dispose(LastAddress, done);

		if (PDirectoryItem(Jimmy)^.GetAddress<>nil) and Valid(PDirectoryItem(Jimmy)^.GetAddress) then begin
			{normal address is fine - see nil check below}
			LastAddress := nil;
		end else begin

			{look thru history}
			FileAdmin(fiHooks)^.LogOn;
			LastAddress := PAddress(HookFile^.GetFirst(PDirectoryItem(Jimmy)^.Ptr2Addresses, srAddress));

			while (LastAddress <> nil) and (not Valid(LastAddress)) do begin
				dispose(LastAddress, done);
				LastAddress := PAddress(HookFile^.GetNextJimmy);
			end;

			FileAdmin(fiHooks)^.LogOff;
		end;

		if LastAddress = nil then begin
			{none found/default wanted}
			LastAddress := PDirectoryItem(Jimmy)^.GetAddress;
			PDirectoryItem(Jimmy)^.Address := nil; {so that we can dispose of lastaddress}
		end;

		if LastAddress = nil then New(LastAddress, init(nil)); {blank}

	end;

	{--- DO REPLACE ------}
	{OK, so we have the right address.  Now format and return in lstring}
	LSClear(LString);
	Replace := True;

	if SubCode = 'TEL' then
		{address tel no}
		LSAppendStr(LString, LastAddress^.GetTelNum(1)+#13#10
												+LastAddress^.GetTelNum(2)+#13#10
												+LastAddress^.GetTelNUm(3))
	else
		if SubCode = 'FAX' then
			{address fax}
			LSAppendStr(LString, LastAddress^.GetFaxNum)
		else begin

			{--- address text -----}
			if pos('/F',Param)>0 then begin {add name}
				LSAppendStr(LString, Jimmy^.GetName(naAddress, 0)+CRLF);
				case JImmy^.srType of
					srPerson : begin
						{add company for, etc}
						if PPerson(Jimmy)^.JobTitle<>'' then LSAppendStr(Lstring, PPerson(Jimmy)^.JobTitle+CRLF);
						if PPerson(Jimmy)^.Dept<>'' then LSAppendStr(Lstring, PPerson(Jimmy)^.Dept+CRLF);
						if PPerson(Jimmy)^.ContactFor<>-1 then
																LSAppendStr(LString, GetJimmyIDName(PPerson(Jimmy)^.ContactFor, naAddress, 0)+CRLF);
					end;
					srCompany : begin
						if PCompany(Jimmy)^.DeptFor<>-1 then
																LSAppendStr(LString, GetJimmyIDName(PCompany(Jimmy)^.DeptFor, naAddress, 0)+CRLF);
					end;
				end;
			end;

			for Line :=1 to LastAddress^.NumLines do
				LSAppendStr(LString, LastAddress^.GetAddressLine(Line)+CRLF);

			{chop off last CRLF}
			if LSLen(LString)>0 then LSDelete(LString, LSLen(LString)-2,2);
		end; {address text}
end;


{*****************************************
 ***          INPUT DIRECTORY          ***
 *****************************************}
constructor TInputDirectory.Init;
begin
	inherited Init(Bounds, NFieldLen, Nfitype, NlsType, NSubIndexString);
	HelpCtx := hcInputDir;
{	CommaTab := 30;{}
	ListOptions := ListOptions or loCheckSuper;
	SuperfiType := fiFullDirIdx;
end;

function TInputDirectory.SearchOn : string;
var S : string;
begin
	S := delspaceR(ucase(Data^));
	if (pos(',',S)>0) then S := PadSpaceR(Copy(S,1,pos(',',S)-1),30)+Copy(S,pos(',',S)+1,256);{}
	SearchOn := SubIndexString+S;
end;

function TInputDirectory.SuperSearchOn : string;
var S : string;
begin
	S := delspaceR(ucase(Data^));
	if (pos(',',S)>0) then S := PadSpaceR(Copy(S,1,pos(',',S)-1),30)+Copy(S,pos(',',S)+1,256);{}
	SuperSearchOn := S;
end;


{======= CREATE LIST ===============}
function TInputDirectory.CreateList;
var
	ListWindow : PIndexedJimmyListWindow;
	Title : string;
begin
	if SubIndexString = '' then
		Title := 'Directory'
	else
		Title := Expandscode(scDirectoryCategory, SubIndexString);

	New(ListWindow, init(
		Bounds, Title,
		New(PDirectoryListView, init(Bounds, lsDirectory, fiType, SubIndexString))
	));

	{Set display type}
	ListWindow^.List^.ListSetup^.MultiLine := False;
	ListWindow^.List^.ListSetup^.View := dvAddr;{}
	ListWindow^.List^.SetTabs;

	CreateList := ListWindow;
end;


{****************************************************************************
 ***                                                                      ***
 ***                THE DirectoryItem OBJECT                                     ***
 ***                                                                      ***
 ****************************************************************************}

constructor TDirectoryItem.Init;
var B : byte;
begin
	inherited Init;
	Dat2Idx := -1;
	AliasIdx := -1;
	for B := 1 to 5 do CategoryIdx[B] := -1;
	ArchiveIdx := -1;

	Ptr2History := -1;
	Ptr2More := -1;
	Ptr2Addresses := -1;

	AddressID := -1;
	DOReg.SetToToday;
	Deleted := False;
end;

procedure TDirectoryItem.CommonInit;
begin
	inherited CommonInit;

	Address := nil;
end;


destructor TDirectoryItem.Done;
begin
	ClearAddress;
	inherited Done;
end;


{procedure TDirectoryItem.LoadSupplements;
begin
	inherited LoadSupplements;

{	if (Address^.RecNo<>AddressID) and (AddressID>-1) then begin {check correct}
{		dispose(Address, done); {created in commoninit}
{		Address := PAddress(JimmyStream^.GetAt(AddressID)); {hmmmm, is this legal?}
{		if Address = nil then begin
			JimmyStream^.CheckStatus('Could not load address at '+N2Str(AddressID));
			New(Address, init(nil));
		end;
		if Address^.Deleted then begin
			dispose(Address, done);
			New(Address, init(nil));
		end;
	end;{}
{end;


{************************************************
 *** VARIOUS VIRTUAL METHODS TO BE OVERRIDEN  ***
 ************************************************}
{Used for list views}
function TDirectoryItem.DisplayLine;
{$IFDEF fixit}
var S : string;
		B : byte;
{$ENDIF}

begin
	DisplayLine := '';

	{$IFDEF fixit}
		{--- Technical aid ----}
		{Add tekky detail}
		S := #13+ '    TEK:'+N2Str(RecNo) + ' Idx'+N2Str(Dat2Idx)
						+ '/Cat';
		for B := 1 to 5 do S := S+N2Str(CategoryIdx[B]);
		S := S  + '/Arc'+N2Str(ArchiveIdx)
						+ '/Ali'+N2Str(AliasIdx)
						+ ' Det'+N2Str(Ptr2More) + ' His'+ N2Str(Ptr2History)+' Add'+N2Str(Ptr2Addresses)
						+ ' Inv'+N2Str(GetInvTo)
						+ ' AID'+N2Str(AddressID);
		if Deleted then S := S + ' Deleted';

		DisplayLine := S;
	{$ENDIF}
end;


{************************************************
 *** NAME FORMATS                             ***
 ************************************************

SPECIFICATION:
	NaDisplay - Surname,Forname
	NaAddress - Title ForeName Surname
	NaFull    - Title Forename Surname
	NaSurFull - Surname, Title Forname
	NaInitials- Title Initials SurName
	NaFirstInit-Title First Initial Surname
	NaDear    - Dear name or Title Surname

	TITLES:   SIR/DAME  - Always have full forename
				 - If just surname was required, substitute just full forename
		LORD - Never have any forename/initials

 NB - Problem if Sir & l% specified, forename does not fit but initial does
 SHOULD be that surname is cancelled & full forename is left
}

function TDirectoryItem.GetName(naType : byte; Maxlen : integer) : string;
begin GetName := 'Name method not defined for this Directory Item'; end;

{default to getting from address}
function TDirectoryItem.GetTelNum;
begin
	GetTelNum := '';
	if GetAddress<>nil then GetTelNum := GetAddress^.GetTelNum(L);
end;

function TDirectoryItem.GetFaxNum;
begin
	GetFaxNum := '';
	if GetAddress<>nil then GetFaxNum := GetAddress^.GetFaxNum;
end;

function TDirectoryItem.GetCategories : string;
begin GetCategories := ''; end;

function TDirectoryItem.GetInvTo : longint;
begin GetInvTo := -1; end;

function TDIrectoryItem.GetContactFor : longint;
begin GetCOntactFor := -1; end;

function TDirectoryItem.Getemail : PAddress;
begin
	FileAdmin(fiHooks)^.LogOn;
	Getemail := PAddress(HookFile^.GetFirst(Ptr2More, srAddress));
	FileAdmin(fiHooks)^.LogOff;
end;

{getaddress}
{These two methods provide a way of accessing the address, useful where
several references *might* be made, eg in the .displayline method.  GetAddress
loads the address first time required, and returns a pointer to it that time
and thereafter.  ClearAddress should be used once the calling method has
finished, so that next time the address is loaded afresh}
function TDirectoryItem.GetAddress;
var Param : TJimmyInitParam;
begin
	if Address=nil then
		Address := PAddress(GetJimmy(AddressID));

	{safety check}
	if (Address<>nil) and (Address^.srType<>srAddress) then begin
		ProgramError('Address ID ('+N2Str(AddressID)+') not Address object, sr='+N2Str(Address^.srType),hcNoContext);
		dispose(Address, done);
		Param.ForWho := RecNo;
		AddressID := -1;
		Address := nil; {New(PAddress, init(@Param));{}
	end;

	GetAddress := Address;{}
end;

procedure TDirectoryItem.ClearAddress;
begin
	if Address<>nil then dispose(Address, done);
	Address := nil;
end;


function TDirectoryItem.GetADdressFor;
var Add : PAddress;
begin
	{first see if currently default address is valid}
	Add := PAddress(GetJimmy(AddressID));
	if (Add=nil) or not Add^.ForDates.inRange(Date) or (apType<>apAny) then begin
		{not valid, or an aptype is specified, so look for one of those
		first - so look through chain}
		if Add<>nil then dispose(Add, done);

		FileAdmin(fiHooks)^.LogOn;
		Add := PAddress(HookFile^.GetFirst(Ptr2Addresses, 0));
		while (Add<>nil) and
					((not Add^.ForDates.inRange(Date)) or ((apType<>apAny) and ((Add^.apType and apType)=0))) do begin
			dispose(Add, done);
			Add := PAddress(HookfIle^.GetNextJimmy);
		end;
		FileAdmin(fiHooks)^.LogOff;

		if Add=nil then Add := PAddress(GetJimmy(AddressID));  {get normal}
		if Add=nil then New(Add, init(nil));
	end;
	GetAddressFor := Add;
end;




{**********************************************************
 ***                    SET FORM CODES                  ***
 **********************************************************}

{function TDirectoryItem.Decode(const Code, Param : TFCodeStr;
																		var LString : TLongString) : boolean;
begin
	Decode := False;
{	if LastWord(Code) = 'ADD' then Decode := DoAddressCode(PreCode, Code, Param, Info, LString);
{}
{end;{}
type
	{special address list form code, removes default address from tree
	and at some point can add parameters such as email only, etc}
	PAddressListFormCode = ^TAddressListFormCode;
	TAddressListFormCode = object(THookListFormCode)
		procedure DoSpecial(var Tree : PTree; Param : TFCodeStr); virtual;
	end;

	procedure Taddresslistformcode.dospecial;
	var AddHook : PHook;

		function Match(Hook : PHook) : boolean; far;
		begin
			Match := Hook^.JimmyID = PDirectoryItem(Info)^.AddressID;
		end;

	begin
		AddHook := PHOok(Tree^.FirstThat(@Match));
		if AddHook<>nil then
			Tree^.DeleteNode(AddHook);
	end;



{======================= GENERAL CODES ========================}
procedure TDirectoryItem.SetFormCodes;
var I : byte;
		Dear, S : string;
		Jimmy : PJimmy;
		Add : PAddress;
		HooKrec : PLongint;

begin
	inherited SetFormCodes(FormCodes);

	{names}
	with FormCodes^ do begin
		SetDate('DTR', DOReg);   {Date of registration}

		{clear shared codes}
		SetStr('DPT', '');  				SetStr('NS', '');
		SetStr('COY', '');					SetStr('NF', '');
		SetStr('JOB', '');    			SetStr('NT', '');
		setStr('ISCC', '');   			SetStr('SUR', '');
		SetStr('CMNT', '');   			SetStr('FOR', '');
		SetStr('PERTEL', ''); 			SetStr('TITLE', '');

		SetStr('NAME',  GetName(naFull,0));
		SetStr('NSF', GetName(naDisplay,0)); {surname, forname}
		SetStr('NRPT', GetName(naReport, 0)); {surname, title forname}

		SetStr('FULLADD','<'+Prefix+'NAME>'+CRLF+'<'+Prefix+'ADD>');

		Dear := GetName(naDear,0); {automatically handles blank}
		SetStr('DN', Dear); {automatically handles blank}
		if Dear<>'NONE' then
			SetStr('DEAR', 'Dear <'+Prefix+'DN>')    {dear name}
		else
			SetStr('DEAR','');

		if (ucase(Dear)='SIRS') or (ucase(Dear)=ucase(ProgramSetup.Get(siImpersonalDear,'Sirs'))) then
			SetStr('YOURS', 'Yours faithfully')
		else
			SetStr('YOURS', 'Yours sincerely');

		Insert(New(PSCodeFOrmCode, init('CAT', GetCategories, scDirectoryCategory)));

		{addresses}
		Add := PAddress(GetJimmy(AddressID));
		if Add<>nil then begin
			Add^.SetFormCodes(FormCodes);
			dispose(Add, done);
		end else begin
			{no address, so clear all codes}
			New(Add, init(nil));
			Add^.SetFormCodes(FormCodes);
			dispose(Add, done);
		end;
		{Access to alternative addresses - this will find first current, but
			overriding with parameters can specify}
		Insert(New(PAddressFormCode, init('ADD', RecNo, apAny, Today)));

		{Override telephones to include personal/whatever}
		{chops off *last* crlfs, but leaves blank lines in, in case user is using
		positions to mark purpose (eg first line, home, 2nd, work, etc}
		S := '';	for I := 1 to 4 do S := S+ GetTelNum(I)+CRLF;
		SetStr('TEL',TrimCRLF(S));

		{attached lists}
		Insert(New(PHookListFormCode, init('CONTACTS', GetJimmy(RecNo), hkContacts, '',0)));
		Insert(New(PAddressListFormCode, init('ADDRESSES', GetJimmy(RecNo), hkAddress, '',0)));
		Insert(New(PHookListFormCode, init('NOTES', GetJimmy(RecNo), hkMore, '',0)));

		{-- email ---}
		{just finds first one}
		SetStr('EMAIL','');
		GetHookOn(hkAddress, Hookrec); {get hook pointer for addresses}
		if (Hookrec<>nil) and (HookRec^<>-1) then begin
			FileAdmin(fiHooks)^.LogOn;
			Add := PAddress(HookFile^.GetFirst(HookRec^, srAddress));

			while (Add<>nil) {and (EmailID=-1)} do begin

				if (Add^.adType=ademail) then begin
					SetStr('EMAIL',Add^.GetFormattedLine(1));
					dispose(Add, done);
					Add := nil;
				end else begin
					dispose(Add, done);
					Add := PAddress(HookFile^.GetNextJimmy);
				end;

			end;

			FileAdmin(fiHooks)^.LogOff;
		end;

		{--- Codes from more-about list -----}
		{Std Addresses}
{$IFDEF kmemship}
		GetHookOn(hkMore, Hookrec);
		if Hookrec<>nil then begin
			FileAdmin(fiHooks)^.LogOn;
			Insert(New(PJimmyFormCode, init('MEM', HookFile^.FindFirst(HookRec^, srMembership))));
			FileAdmin(fiHooks)^.LogOff;
		end else
			Insert(New(PJimmyFormCode, init('MEM', -1)));
{$ENDIF}

	end;

end;


{****************************************************
 *** STREAMING                                    ***
 ****************************************************}
{THE LOAD AND STORE *MUST* MATCH, AS THE INDEX IS CALCULATED ASSUMING
RECORDS ALL OF THE SAME LENGTH. USE RECSIZE SET THE SIZE}
function TDirectoryItem.RecSize;
begin RecSize := 60; end; {leave room for pointers}

{------- LOAD MAIN DATA ----------}
constructor TDirectoryItem.Load;
begin
	inherited Load(S); {common init, lock & deleted fields}

	S.Read(AddressID, 4);

	DOReg.Load(S);
end;

{-------- STORE MAIN DATA ----------}
procedure TDirectoryItem.StoreFields;
begin
	{SEE ALSO HookPtr/IdxPtr methods for pointer positioning}
	inherited StoreFields(S);

	S.Write(AddressID, 4);

	DOReg.Store(S);
end;


procedure TDirectoryItem.OnStoreing(const DiskJimmy : PJimmy);
var COntact : PDirectoryItem;
		View : PView;
		OldAddressID : longint;
begin
	inherited OnStoreing(DiskJImmy);

	{Store address}
	{cant/shouldn't do in .store as it moves the jimmystream read position}
{	if (not Address^.Blank) or (Address^.RecNo<>-1) then begin {blank or already been stored at some point}
{		if Address^.ForWho = -1 then Address^.ForWho := RecNo; {point to self}
{		Address^.StoreSelf;
		AddressID := Address^.RecNo;
		StorePtr(1+1+1+44, AddressID); {store pos - maybe not known before getaddress^.storeself}
{	end;{}


	{check "contacts" list, change their addresses if nec.}
	{The point here is that if a company changes its address *pointer* (eg it
	has moved, and rather than editing the address the user has typed in a new
	one, keeping the old for reference, then all contacts should have their
	pointers changed too, *if* they were the same as the company old pointer...}
	if (DiskJimmy<>nil) and (PDirectoryItem(DiskJimmy)^.AddressID<>AddressID) then begin
		OldAddressID := PDirectoryItem(DiskJimmy)^.AddressID;
		FileAdmin(fiHooks)^.LogOn;
		Contact := PDirectoryItem(HookFile^.GetFirst(Ptr2More, srPerson));
		while Contact<>nil do begin
			{update on file}
			if Contact^.AddressID = OldAddressID then {same as old coy one, so update to new one}
				{quick write-just-ptr as above, replacing with new one.  AddressID follows immediately after other ptrs}
				Contact^.StorePtr(Contact^.HookPtrPos(Contact^.NumhkTypes+1), AddressID);
			{udpate on screen}
			View := GetJimmyView(COntact^.RecNo,0);
			if VIew<>nil then begin
				View^.GetData(Contact^);
				if Contact^.AddressID = OldAddressID then begin
					Contact^.AddressID := AddressID;
{					Contact^.Address^.CopyFrom(Address);{}
					UpdateJimmyView(Pgroup(View), Contact);
				end;
			end;
			dispose(Contact, done);
			Contact := PDirectoryItem(HookFile^.GetNextJimmy);
		end;
		FileAdmin(fiHooks)^.LogOff;
	end;
end;


{============== POINTERS TO OTHER JIMMYS===================}
function TDirectoryItem.NumIDs;
begin NumIDs := 1; end;

function TDirectoryItem.GetJImmyID;
begin
	case jiType of
		1 : GetJimmyID := @AddressID;
	else
		GetJimmyID := nil;
	end;
end;


{************************************************
 ***               INDEXING                   ***
 ************************************************}
function TDirectoryItem.NumixTypes : byte;
begin Numixtypes := 7; end;

procedure TDirectoryItem.GetIndex;
begin
	inherited GetIndex(ixType, IdxRec, fiType);
	case ixType of
		ixArchive : begin IdxRec := @ArchiveIdx; fiType := fiArchiveIdx; end;

		1 : begin IdxRec := @Dat2Idx; 				fiType := fiFullDirIdx; end;
		2 : begin IdxRec := @AliasIdx; 				fiType := fiFullDirIdx; end;
		3 : begin IdxRec := @CategoryIdx[1]; 	fiType := fiCatDirIdx; end;
		4 : begin IdxRec := @CategoryIdx[2]; 	fiType := fiCatDirIdx; end;
		5 : begin IdxRec := @CategoryIdx[3]; 	fiType := fiCatDirIdx; end;
		6 : begin IdxRec := @CategoryIdx[4]; 	fiType := fiCatDirIdx; end;
		7 : begin IdxRec := @CategoryIdx[5]; 	fiType := fiCatDirIdx; end;
	end;
	{descendants set key}
end;

function TDirectoryItem.GotByAlias;
begin
	case fitype of
		fiFullDirIdx 	: GotByAlias := (GotByix = 2);
	else
		GotByAlias := False;
	end;
end;

{************************************************
 ***               HOOKING                    ***
 ************************************************}
function TDirectoryItem.NumhkTypes : byte;
begin NumhkTypes := 5; end; {hkAccounts is highest}

procedure TDirectoryItem.GetHookOn(const hkType : byte; var HookRec : PLongint);
begin
	inherited GethookOn(hkType, HookRec);
	case hkType of
		hkHistory 	: HookRec := @Ptr2History;
		hkMore			: HookRec := @Ptr2More;
		hkAddress 	: HookRec := @Ptr2Addresses;
		hkContacts 	: HookRec := @Ptr2Contacts;
		hkAccounts 	: Hookrec := @Ptr2Accounts;
	end;
end;

{***************************************************************************
 ***                EDIT DIRECTORY ITEM                                  ***
 ***************************************************************************}
procedure TDirectoryItem.MakeEditBox;
var R : TRect;
		B : byte;
begin
	{Parents should do inherited AFTER creating box and BEFORE adding own fields}
	{$IFDEF fixit}
	with EditBox^ do begin
		GrowTo(Size.X, Size.Y+3); {Add an extra line}

		Insert(New(PSkipBytes, init(Sizeof(TObject))));

		{data item stuff}
		R.XYLD(5, Size.Y-4, 6, 1); Insert(New(PInputLint, init(R,8))); AddLabel('Rec',Current);
		R.Move(10,0);							 Insert(New(PInputBYte, init(R,3))); AddLabel('Ter',Current);
		R.Move(10,0);							 Insert(New(PInputBYte, init(R,3))); AddLabel('Cou',Current);

		{jimmy stuff}
		R.Move(10,0);							 Insert(New(PInputBYte, init(R,3))); AddLabel('ix',Current);
		R.Move(10,0);							 Insert(New(PInputBoolean, init(R))); AddLabel('Del',Current);
		R.Move(10,0);							 Insert(New(PInputBoolean, init(R))); AddLabel('Tag',Current);
		R.Move(10,0);							 Insert(New(PInputBoolean, init(R))); AddLabel('AlDel',Current); {allow deletion}
		Insert(New(PSkipBytes, init(sizeof(TTimer)))); {skip insert-ttime timer}

		{directory stuff}
		InsTitledField( 5, Size.Y-3, 5, 1, 'Arc', New(PInputLint, init(R,6)));
		InsTitledField(15, Size.Y-3, 5, 1, 'Idx', New(PInputLint, init(R,6)));
		InsTitledField(25, Size.Y-3, 5, 1, 'Ali', New(PInputLint, init(R,6)));
		InsTitledField(35, Size.Y-3, 5, 1, 'Cat', New(PInputLint, init(R,6)));
		for B := 0 to 3 do InsTitledField(42+B*7, Size.Y-3, 5, 1, '', New(PInputLint, init(R, 6)));

		InsTitledField( 5, Size.Y-2, 5, 1, 'Nte', New(PInputLint, init(R,6)));
		InsTitledField(15, Size.Y-2, 5, 1, 'His', New(PInputLint, init(R,6)));
		InsTitledField(25, Size.Y-2, 5, 1, 'Add', New(PInputLint, init(R,6)));
		InsTitledField(35, Size.Y-2, 5, 1, 'Con', New(PInputLint, init(R,6)));
		InsTitledField(45, Size.Y-2, 5, 1, 'Bil', New(PInputLint, init(R,6)));

		InsTitledField( 5, Size.Y-1, 6, 1, 'Add', New(PInputLint, init(R,6)));
		Insert(New(PSkipBytes, init(sizeof(PAddress)))); {past address ptr}

		InsTitledField(20, Size.Y-1,10, 1, 'DOR', New(PInputDate, init(R)));
	end;
	{$ELSE}
		EditBox^.Insert(New(PSkipBytes, init(sizeof(TDirectoryItem))));
	{$ENDIF}

end;


{================ EDIT =========================}
function TDirectoryItem.Edit(const Caller, AcceptorView : PView) : word;
begin
	{Before starting, check for warning bleep.  Mostly for Solitaire, but also
	for anyone else to draw attention}
	{IDeally want this then to focus on the search line...}
	if Copy(GetCategories,1,1) = '!' then begin
		PayAttentionBleep;
{leave it at that, irritating box (irritating noise!)
		PauseMessage('NOTE!',ExpandScode(scDirectoryCategory, GetCategories),hcDirCatNoteMsg);{}
	end;

	inherited Edit(Caller, AcceptorView);
end;

{*****************************************************************
 ***                DIAL                                       ***
 *****************************************************************}
{Really we ought to send the dial procedure an array of records:
	TelNum
	Country
	Extension
for each telephone, but at the moment it's just telnums by line}

procedure TDirectoryItem.Dial(LineNo : byte);
var	I : longint;
		TelNum : String;
		TargetCountry : TSCode;
		Add : PAddress;
		Coy : PDirectoryItem;
		Extension : string;

	procedure AddTelNum(S : string);
	begin
		if S<>'' then TelNum := TelNum+S+CRLF;
	end;

begin
	Extension := '';
	TelNum := '';

	if LineNo<>0 then begin
		{telephone number specified}
		AddTelNum(GetTelNum(LineNo)); {see modem for dial function}
	end else begin
		TelNum := '';
		for I := 1 to 7 do AddTelNum(GetTelNum(I));
	end;

	{now check for any more if a company/contact for}
	if GetContactFor<>-1 then begin
		Coy := PDirectoryItem(GetJimmy(GetContactFor));
		if Coy<>nil then begin
			if Coy^.AddressID<>AddressID then begin
				for I := 1 to 4 do
					AddTelNum(Coy^.GetAddress^.GetTelNum(I));
			end;
			dispose(Coy, done);
		end;
	end;

	{country of target (assume this one, don't worry about getcontactfor one being different!)}
	Add := GetAddress;
	if Add<>nil then
		TargetCountry := Add^.Country
		{don't dispose...}
	else
		TargetCountry := '';

	{and DIAL!}
	TelNum := TrimCRLF(TelNum);
	Modems.Dial(TelNum, TargetCountry); {and dial - see modem unit}
end;

{*****************************************************************
 ***                      PRINT                                ***
 *****************************************************************}
procedure TDirectoryItem.PrintLabel;
var Add : PAddress;
begin
	if LabelAs = 0 then LabelAs := apCorrespondence;
	Add := GetAddressFor(Today, LabelAs);
	Add^.PrintLabel(Device,0);
	dispose(Add, done);
end;

procedure TDirectoryItem.PrintFull;
var Jimmy :PJimmy;
begin
	ThinkingOn('Printing details');

	{write general details, if print not already started (eg by descendants)}
	if not Device^.Active then begin
		SetFormCodes(Device^.FormCodes);

		Device^.StartPrint('DIRECTRY','');
		if not Device^.FormFound then begin
			Device^.Writeln('DIRECTORY '+GetName(naFull,0)+' No DIRECTRY.HDR found');
		end;
	end;

	{put in form now as <ADDRESSES>
	FileAdmin(fiHooks)^.LogOn;
	{--- Addresses ---}
{	Jimmy := HookfIle^.GetFirst(Ptr2Addresses, 0);
	while Jimmy<>nil do begin
		if Jimmy^.RecNo<>AddressID then Jimmy^.PrintLine(Device);
		dispose(Jimmy,done);

		Jimmy := HookFile^.GetNextJimmy;
	end;

	{-----More About list-----}
{	Jimmy := HookfIle^.GetFirst(Ptr2More, 0);
	while Jimmy<>nil do begin
		Device^.writeln('_____________________________________________________________________');
		Jimmy^.PrintSummary(Device,0);
		dispose(Jimmy,done);

		Jimmy := HookFile^.GetNextJimmy;
	end;
	FileAdmin(fiHooks)^.LogOff;{}
	Device^.EndPrint;
	ThinkingOff;
end;

{Default list print & <contacts> code uses this}
procedure TDirectoryItem.PrintLine;
var S : string;
begin
	S := SetLength(GetName(naReport, 30),30);

	S := S + Setlength(delspace(GetTelNum(1)),30);
	if GetAddress<>nil then begin
		S := S+Address^.Town;
		ClearAddress;
	end;

	Device^.writeln(S);
end;

procedure TDirectoryItem.PrintSummary;
begin
	PrintForm(Device, 'DIRECTRY.FRM');
end;


{*************************************************************************
 ***                                                                   ***
 ***                  DIRECTORY LIST VIEWER                            ***
 ***                                                                   ***
 *************************************************************************}

procedure TDirectoryListSetup.Load;
begin
	View 			:= S2Num(Get('VIEW',N2Str(dvTelAddr)));
	MultiLine := not GetBoolean('SINGLELINE',False);
end;


procedure TDirectoryListSetup.Store;
begin
	Put('VIEW', N2Str(View));
	PutBoolean('SINGLELINE',not MultiLine);

	ProgramSetup.Store;
end;

{============ EDIT ======================}
procedure TDirectoryListSetup.AddSetupLines(EditBox : PEditBox);
var	R : TRect;

begin
	with EditBox^ do begin
		GrowTo(38,14);

		InsTitledField(11,2, 1, 1, 'MultiLine', New(PInputBoolean, init(R)));
		InsTitledField(11,4, 24,7, 'View',
						New(PRadioButtons, init(R,
							NewSItem('Just name',
							NewSITem('Address',
							NewSItem('Telephone & Postcode',
							NewSItem('Telephone & Town',
							NewSItem('Codes & Comment',
							NewSItem('Crammed',
							NewSItem('Telephone',
						nil))))))))));
	end;
end;


{***************************************************
 ***              DIRECTORY LIST VIEW            ***
 ***************************************************}

{=== INITIALISE ==========================================}
constructor TDirectoryListView.Init;
begin
	Inherited Init(Bounds, Nlstype, NfiType, NCat);

	HelpCtx := hcDirectoryList;

	ListSetup := New(PDirectoryListSetup, init(sgDirectory));
	SetTabs;
end;

{overrides normal print label to present a list of options to user of
different addresses available}
{procedure TDirectoryListView.DoLabel;
var DirItem : PDirectoryitem;


	procedure AddToMenu(Node : PNode); far;
	begin
	end;

begin
	DirItem := PDirectoryItem(PIndexedJimmyStream(Stream(fiType))^.GetJimmyatIdx(Focused)));
	if DirItem=nil then exit;

	{create menu}
{	FileAdmin(fiHooks)^.LogOn;
	HookFile^.ForEach(DirItem^.Ptr2Addresses, @AddToMenu);
	FileAdmin(fiHooks)^.LogOff;

	DoPopUpMenu(Menu, Owner);

	{get appropriate address}

	{can't do this just now, 'cos there's no way of getting the header
	(ie person's anem & job, and company's name) w/o the address, at the
	moment... so just ask for type}

procedure TDirectoryListView.DoLabel;
var DirItem : PDirectoryitem;
		Menu : PMenu;
		apType : word;

begin
	DirItem := PDirectoryItem(PIndexedJimmyStream(Stream(fiType))^.GetJimmyatIdx(Focused));
	if DirItem=nil then exit;

	Menu := NewMenu(
		NewItem('~C~orrespondence',  	'', kbNone, apCorrespondence, hcNoContext,
		NewItem('~H~ome',  						'', kbNone, apHome, hcNoContext,
		NewItem('~W~ork',  						'', kbNone, apWork, hcNoContext,
		NewItem('~I~nvoice',  		  	'', kbNone, apInvoice, hcNoContext,
		NewItem('~D~elivery',  				'', kbNone, apDelivery, hcNoContext,
	nil))))));

	apType := DoPopUpMenu(Menu, Owner);

	if apType>0 then
		case Command of
			cmPrintLabel 	: DirItem^.DoLabelNow('',1,apType);
			cmDeferLabel  : DirItem^.DeferLabel('',1,apType);
		end;

	dispose(DirItem, done);
end;

{==== HANDLE EVENT =================================}
procedure TDirectoryListView.HandleEvent;
var	DirectoryItem : PDirectoryItem;

begin
	if DrawnFocused and (Event.What = evKeyDown) and (Event.KeyCode = kbSuperChange) then begin
		{Super-change key - does "edit" then something, eg in person it brings up
		person details and goes straight to company in contact for...}
		PutEvent(Event);

		{and ask to edit}
		Event.What := evCommand;
		Event.Command := cmEdit;
	end;

	if (Event.What = evCommand) and DrawnFocused then begin

		case Event.Command of

			{--- Dial directly from list ---------}
			cmDial : begin
				DirectoryItem := PDirectoryItem(PIndexedJimmyStream(Stream(fiType))^.GetJimmyAtIdx(Focused));
				DirectoryItem^.Dial(0);
				Dispose(DirectoryItem, Done); DirectoryItem := nil;
				ClearEvent(Event);
			end;{}

			{Attached information - edit & press button automatically}
			cmAccounts, cmHistory, cmMoreAbout : begin
				{Stack up which button will be pressed}
				Event.What := evKeyDown;
				case Event.Command of
					cmHistory 	: Event.KeyCode := kbHistory;
					cmMoreAbout : Event.KeyCode := kbMore;
					cmAccounts 	: Event.KeyCode := kbAccounts;{}
				end;
				QueueEvent(Event);
				case Event.Command of
					kbMore, kbAccounts : begin
						Event.KeyCode := kbZoom;
						QueueEvent(Event);
					end;
				end;

				{and ask to edit}
				Event.What := evCommand;
				Event.Command := cmEdit;
			end;

			{$IFDEF kmaint}
				cmMerge : begin MergeDirectoryItems; Redraw; FocusItem(TopItem); ClearEvent(Event);  ClearSearch; end; {Maintenance option}
			{$ENDIF}

			cmTagSelected : begin
				TagSelected;
				ClearEvent(Event);
			end;

			{override print label for multiple addresses...}
			cmPrintLabel, cmDeferLabel : begin
				DoLabel(Event.Command);
				ClearEvent(Event);
			end;

		end; {case}
	end;

	inherited HandleEvent(EVent);

	{--- Cursor R/L: Change view ------}
	if Event.What = evKeyDown then begin
		if Event.KeyCOde = kbRight then begin
			ListSetup^.View := ListSetup^.View +1;
			if ListSetup^.View > 5 then ListSetup^.View := 0; {set back to 0}
			ListSetup^.Store;
			SetTabs;
			Redraw;
			ClearEvent(Event);
		end;

		if Event.KeyCOde = kbLeft then begin
			if ListSetup^.View >0 then
				ListSetup^.View := ListSetup^.View -1
			else
				ListSetup^.View := 5;
			ListSetup^.Store;
			SetTabs;
			Redraw;
			ClearEvent(Event);
		end;
	end;
end;


procedure TDirectoryListView.SetTabs;
var S23, S5, S2, S3,S4,S9 : integer;
begin
	if ListSetup=nil then begin
		Tabs := '';
		exit;
	end;

	S2 := Size.X div 2;  {80 col = 40}
	S3 := Size.X div 3;  {80 col = 26}
	S23 := (S2 + S3) div 2; {33}
	S4 := Size.X div 4;  {80 col = 20}
	S5 := Size.X div 5;  {80 col = 16}
	S9 := Size.X div 9; {80 col = 9}

	case ListSetup^.View of
		dvCrammed : Tabs :=  char(MaxOf(10, S4))
												+char(MaxOf(15, S23))
												+char(MaxOf(15, S23)+S5)
												+char(MaxOf(15, S23)+S5+S5)
												+char(MaxOf(15, S23)+S5+S5+5);
	else
								Tabs :=  char(MaxOf(10, S3))
												+char(MaxOf(15, S2))
												+char(MaxOf(15, S2)+S4)
												+char(MaxOf(15, S2)+S4+S9);

	end;
end;


{******************************
 *** PRINTS ALL (OR TAGGED) ***
 ******************************}
procedure TDirectoryListView.PrintEach;
var DirectorySearch : PDirectorySearch;
		Title, DescMsg : string; {also appear on report}

begin
	if ListEmpty then begin
		PauseMessage('Print List','No List to Print!', hcNoContext);
		exit;
	end;

	Title := PWindow(Owner)^.Title^; if TaggedOnly then Title := 'Tagged '+Title;
	DescMsg := ExpandSCode(scDirectoryCategory, SubIndexString);

	New(DirectorySearch, init(Title, DescMsg,fiType,FirstItem,LastItem,nil,nil));
	with DirectorySearch^ do begin
		PDirectorySearchOptions(SearchOptions)^.TaggedOnly := TaggedOnly;
		PDirectorySearchOptions(SearchOptions)^.FullDirectory := False; {use this list}
		AskForSearch := False;
		OnceOnly := True;
		OnSearchOKDo := cmPrint; {force immediate print}
		DoSearch;
	end;
	dispose(DirectorySearch, Done);
end;


{******************************
 *** TAGS SELECTED         ***
 ******************************}
procedure TDirectoryListView.TagSelected;
var DirectorySearch : PDirectorySearch;
		Title, DescMsg : string; {also appear on report}

begin
	if ListEmpty then begin
		PauseMessage('Tag','No List to Search!', hcNoCOntext);
		exit;
	end;

	Title := PWindow(Owner)^.Title^;
	DescMsg := 'Tagging selected of '+ExpandSCode(scDirectoryCategory, SubIndexString);

	New(DirectorySearch, init(Title, DescMsg,fiType,FirstItem,LastItem,nil,nil));
	with DirectorySearch^ do begin
		PDirectorySearchOptions(SearchOptions)^.FullDirectory := False; {use this list}
		AskForOutput := False;
		OnSearchOKDo := cmPrint;
		OnceOnly := True;
		PrintOptions.Tag := True; {just tag 'em}
		PrintOptions.PrintAs := paNothing;
		DoSearch;
	end;
	dispose(DirectorySearch, Done);

	Redraw;
end;


{**************************************************************************
 ***                                                                    ***
 ***                     SPECIAL SENTENCE CODES                         ***
 ***                                                                    ***
{**************************************************************************}

{========= Category CODES ====================================}
{These have an extra margin field, used for automatic product pricing.
So keep it hidden unless kproducts unit included...}

const
 RDirCatSCodeItem : TStreamRec = (
	 ObjType : srDirCatScodeItem;
	 VmtLink : Ofs(TypeOf(TDirCatScodeItem)^);
	 Load : @TDirCatScodeItem.Load;
	 Store : @TDirCatScodeItem.Store
 );

constructor TDirCatScodeItem.Init;
begin
	inherited Init(NCode, NDesc);
	Margin := NMargin;
end;

constructor TDirCatScodeItem.Load;
begin
	inherited Load(S);
	S.Read(Margin, 2);
end;

procedure TDirCatScodeItem.Store;
begin
	inherited Store(S);
	S.Write(Margin, 2);
end;

function TDirCatScodeItem.DisplayLine;
var S : string;
begin
	S := inherited DisplayLine(Maxlen);
{$IFDEF kgoods}
	S := SetLength(S, Maxlen-length(N2Str(Margin))-1)+N2Str(Margin)+'%';
{$ENDIF}
	DisplayLine := S;
end;

procedure TDirCatScodeItem.AddEditFields(P : PObjectEditBox);
var R : TRect;
begin
	inherited AddEditFields(P);
{$IFDEF kproduct}
	P^.GrowTo(P^.Size.X, P^.Size.Y+1); {make room for below}
	P^.InsTitledField(9,4, 4, 1, '%Margin', New(PInputInt, init(R,4)));
{$ELSE}
	P^.Insert(New(PSkipBytes, init(2)));
{$ENDIF}
end;

function TDirCatScodeItem.Print;
begin
	Device^.writeln('    '+padspaceR(Code,3)
														+'  '+setlength(Description^,50)
														+'  '+padspaceL(N2Str(Margin)+'%',9));
end;

function CreateDirCatScodeItem(const NCode, NDesc : string) : PScodeItem; far;
begin
	CreateDirCatScodeItem := New(PDirCatScodeItem, init(NCode, NDesc,0));
end;


type
	PDirSCodeCollection = ^TDirSCodeCollection;
	TDirSCodeCollection = object(TSCodeCollection)
		procedure LoadCodes(LockStatus : byte);   virtual;  {adds menu updating}
		procedure StoreCodes(LockStatus : byte); virtual;
		procedure UpdateMenu;
	end;

procedure TDirSCodeCollection.LoadCodes;
begin
	inherited LoadCodes(LockStatus);
	UpdateMenu;
end;

procedure TDirSCodeCollection.StoreCodes;
begin
	inherited StoreCodes(LockStatus);
	UpdateMenu;
end;


procedure TDirSCodeCollection.UpdateMenu;
var cmCommand : word;

	procedure AddToMenu(SCode : PScodeItem); far;
	var S : string;
	begin
		{If it crashes here in the install program it's due to duff kdircat.sc
		codes - easiest to delete kdircat.sc}
		S := Scode^.Description^;
		if minilib.Count('~', S)<>2 then begin
			S := deltildes(S);
			S := '~'+S[1]+'~'+Copy(Scode^.Description^,2,30);
		end;

		AddItemEnd(DirCategoryMenu^.SubMenu, NewItem(S,'', 0, cmCommand, hcDirectory, nil));
		inc(cmCommand);
	end;

begin
	{clear dynamic menu}
	if DirCategoryMenu^.SubMenu<>nil then DisposeMenu(DirCategoryMenu^.SubMenu);
	DirCategoryMenu^.SubMenu := nil;

	{start with make-special}
	AddItemEnd(DirCategoryMenu^.SubMenu,
			NewItem('Previously Selected', '', 0, cmStartSpecialDirList, hcSpecialDirectory, nil));

	{run through collection adding to menu}
	cmCommand := cmDirectoryCategoryStart;
	ForEach(@AddToMenu);
end;


{**************************************************************************
 ***                                                                    ***
 ***                    MAINTENANCE TYPE WORK                           ***
 ***                                                                    ***
{**************************************************************************}

{**********************************************
 ***           MERGE TWO PEOPLE             ***
 **********************************************}
procedure MergeDirectoryItems;
var
	R : Trect;
	EditBox : PEditBox;
	Command : word;
	TargetItem, SourceItem : PDirectoryItem;
	Disk : record
		TargetID, SourceID : longint;
	end;

	procedure MoveHookList(HookID : longint);
	var Hook : PHook;
			HookTo, SubHookTo : PLongint;
			HooKJimmy : PJimmy;
			htType,hkType : byte;
			Key : longint;
			InsBias : boolean;

	begin
		while HookID<>-1 do begin
			Hook := PHook(HookFile^.GetNext(HookID));
			if Hook <> nil then begin
				HookJimmy := GetJimmy(Hook^.JimmyID);
				if HookJimmy<>nil then begin
					for htType := 1 to HookJimmy^.NumHookTo do begin
						HookJimmy^.GetHookTo(htType, HookTo, SubHookTo, hkType, Key, InsBias);
						if (HookTo<>nil) and (HookTo^ = Disk.SourceID) then
							HookTo^ := Disk.TargetID;
					end;
					HookJimmy^.StoreSelf;
					dispose(HookJimmy, done);
				end;
				dispose(Hook, done);
			end;
		end; {while}
	end;


begin
	FileAdmin(fiHooks)^.LogOn;
	FileAdmin(fiJimmys)^.LogOn;

	{========= INPUT WHICH TWO PEOPLE =========================}
	R.Assign(0,0, 30, 8);
	New(EditBox, init(R, 'Merge Directory Entries',nil));
	with EditBox^ do begin

		Options := Options or ofCenterx or OfCenterY;

		InsTitledField(14,2,12,1,'Replacement', New(PInputDirectory, init(R, 15, fiFullDirIdx, lsDirectory, '')));
		InsTitledField(14,3,12,1,'To Delete',New(PinputDirectory, init(R, 15, fiFullDirIdx, lsDirectory, '')));

		InsOKButton(3,  5, @Disk);
		InsCancelButton(14, 5);

		EndInit;
	end;

	Command := Desktop^.ExecView(EditBox);

	dispose(EditBox, done); {getdata done in okbutton}

	if Command = cmOK then begin
		TargetItem := PDirectoryItem(JimmyStream^.GetAt(Disk.TargetID));
		TargetItem^.SetLock(True); {JimmyStream^.PutAt(Disk.TargetID, TargetItem);{}

		SourceItem := PDirectoryItem(JimmyStream^.GetAt(Disk.SourceID));
		sourceItem^.SetLock(True); {JimmyStream^.PutAt(Disk.sourceID, SourceItem); auto store}

		if (TargetItem=nil) or (SourceItem=nil) then begin
			InputWarning('Could not retrieve both items'#13#10'Abandoning', hcInternalErrorMsg);
			exit;
		end;

		if MessageBox('CONFIRM MERGE',SourceItem^.GetName(naFull,0)+' to be added to '+TargetItem^.GetName(naFull,0)
									+#13#10+' And then deleted',mfConfirmation+mfYesNo,hcDirMerge) = cmYes then begin

			{copy address}
			if TargetItem^.AddressID = -1 then TargetITem^.AddressID := SourceItem^.AddressID;
			SourceItem^.AddressID := -1;

			{========== MERGE MORE ABOUT LISTS =================}
			ThinkingOn('Merging More-About');
			{run through source's more-about list, inserting into targets}
			MoveHookList(SourceItem^.Ptr2More);
			SourceItem^.Ptr2More := -1;
			ThinkingOff;

			{=========== MERGE HISTORY LISTS =====================}
			ThinkingOn('Merging Histories');
			{Run through source's chain, inserting into target's}
			MoveHookList(SourceItem^.Ptr2History);
			SourceItem^.Ptr2History := -1;
			ThinkingOff;

			{=========== MERGE CONTACTS LISTS =====================}
			ThinkingOn('Merging Contacts');
			{Run through source's chain, inserting into target's}
			MoveHookList(SourceItem^.Ptr2Contacts);
			SourceItem^.Ptr2Contacts := -1;
			ThinkingOff;

			{=========== MERGE ADDRESS LISTS =====================}
			ThinkingOn('Merging Addresses');
			{Run through source's chain, inserting into target's}
			MoveHookList(SourceItem^.Ptr2Addresses);
			SourceItem^.Ptr2Addresses := -1;
			ThinkingOff;

			{=========== MERGE ACCOUNTS LISTS =====================}
			ThinkingOn('Merging Accounts');
			{Run through source's chain, inserting into target's}
			MoveHookList(SourceItem^.Ptr2Accounts);
			SourceItem^.Ptr2Accounts := -1;
			ThinkingOff;

			{============= DELETE SourceItem =========================}
			SourceItem^.Deleted := True;
			SourceItem^.SetLock(False);
			SourceItem^.StoreSelf;

			TargetItem^.SetLock(False);
			TargetItem^.LoadAllPtrs; {update after rehooking}
			TargetItem^.StoreSelf; {store target item}
		end;

		Dispose(TargetItem, done);
		dispose(SourceItem, done);

	end;

	FileAdmin(fiHooks)^.LogOn;
	FileAdmin(fiJimmys)^.LogOn;
end;


{**********************************
 ***   ADMIN CREATION FUNCTIONS ***
 **********************************}

{==== DIRECTORY STREAM ============}
function NewDirectoryFullIndex : PStream; far;
begin NewDirectoryFullIndex := New(PIndexedJimmyStream, init('DIRECTRY.IDX',TDirectoryIndexSize)); end;

function NewDirectoryCatIndex : PStream; far;
begin NewDirectoryCatIndex := New(PIndexedJimmyStream, init('DIRCATGY.IDX',TDirectoryIndexSize)); end;

function NewDirectorySpecialIndex : PStream; far;
begin NewDirectorySpecialIndex := New(PIndexedJimmyStream, init('DIRSPEC.IDX',TDirectoryIndexSize)); end;

{==== DIRECTORY LIST ================}
function NewDirectoryItemList(fiType : byte; Title : string; Cat : TScode) : PListView;
var Bounds : TRect;
		List : PDirectoryListView;
begin
	Desktop^.GetExtent(Bounds);
	if Cat<>'' then Cat := setlength(ucase(Cat),3);

	List := New(PDirectoryListView, Init(Bounds, lsDirectory, fiType,Cat));

	Kameleon^.InsertWindow(New(PIndexedJimmyListWindow, init(Bounds, Title, List)));

	NewDirectoryItemList := PListView(Desktop^.Current);
end;

{Category sentence code number corresponds directly with fitype, which is
also equal to last digit of file number}

procedure StartDirectoryList;
begin NewDirectoryItemList(fiFullDirIdx, 'Full Directory', ''); end;

procedure StartSpecialList; far;
begin NewDirectoryItemList(fiSpecialDirIdx, 'Special Directory', ''); end;

procedure StartOftenDirList1; far;
begin
	NewDirectoryItemList(	fiCatDirIdx,
												ExpandSCode(scDirectoryCategory, DirectorySetup.Often[1]),
												DirectorySetup.Often[1]);
end;

procedure StartOftenDirList2; far;
begin
	NewDirectoryItemList(	fiCatDirIdx,
												ExpandSCode(scDirectoryCategory, DirectorySetup.Often[2]),
												DirectorySetup.Often[2]);
end;

procedure StartOftenDirList3; far;
begin
	NewDirectoryItemList(	fiCatDirIdx,
												ExpandSCode(scDirectoryCategory, DirectorySetup.Often[3]),
												DirectorySetup.Often[3]);
end;

procedure StartCatDirectoryList;  far;
var AcceptorLine : PInputSCode;
		R : TRect;
		SCode : TScode;

begin
	{Select type}
	R.Assign(3,5,10,5); New(AcceptorLine, init(R, scDirectoryCategory));
	Desktop^.Insert(AcceptorLine); {has to, so that IsView works for accepting}

	AcceptorLine^.ExecuteList; {who knows, it might work}

	AcceptorLine^.GetData(Scode);

	dispose(AcceptorLine, done);

	if Scode<>'' then begin
		NewDirectoryItemList(fiCatDirIdx, ExpandScode(scDirectoryCategory, Scode)+' Category', Setlength(Scode,3));
	end;

end;

procedure StartCommandCatDirectoryList(Command : word);  far;
var	SCode : TScode;
		SCodeItem : PScodeItem;

begin
	{given word command from menu, get category code}
	ScodeCollection[scDirectoryCategory]^.LogOn;

	ScodeItem := PSCodeItem(ScodeCollection[scDirectoryCategory]^.At(Command-cmDirectoryCategoryStart));
	if ScodeItem<>nil then begin
		SCode := ScodeITem^.Code;
		NewDirectoryItemList(fiCatDirIdx, ExpandScode(scDirectoryCategory, Scode)+' Category', Setlength(Scode,3));
	end;

	ScodeCollection[scDirectoryCategory]^.LogOff;
end;

{********************************************************
 ***            FIND/LOOKUP DIRECTORY                 ***
 ********************************************************}
procedure FindDirectory; far;
var EditBox : PEditBox;
		R : TREct;
		ID : longint;
		Control : word;
		Directoryitem : Pdirectoryitem;
		InpLine : PInputJimmy;

begin
	R.ASsign(0,0,33,7);
	New(EditBox, init(R, 'Lookup Directory Entry',nil));
	with EditBox^ do begin
		Options := Options or ofCentered;

		InpLine := PInputJimmy(InsTitledField(3, 2, 26, 1, '', New(PInputDirectory, init(R, 26, fiFullDirIdx, lsDirectory, ''))));

		InsOKButton(9, 4, @ID);
		InsCancelButton(20, 4);
		EndInit;
	end;

	repeat
		Control := Desktop^.ExecView(EditBox);

		if (Control =cmOK) and (InpLine^.GetJimmy<>nil) then begin

			DirectoryItem := PDirectoryItem(GetJimmy(InpLine^.ID));

			DirectoryItem^.Edit(Desktop, nil);
		end;
	until Control = cmCancel;

	dispose(EditBox, done);

end;



{******************************************
 ***         UNIT INSTALLATION          ***
 ******************************************}
{unit initialisation procedure}
begin
{$IFDEF fixit} writeln('Directory...'); {$ENDIF}

	{set up default dynamic menu items}
	DirCategoryMenu := NewSubMenu('~O~ther',   kbNone, hcOtherDirectory,
		NewMenu(
			NewItem('Dummy', '', kbNone, 1, hcNoContext,
		nil)),
	nil);

	OftenDirItem[1] := NewItem('~C~ustomers',   '', kbNone, cmStartOftenDirList1, hcDirectory, nil);
	OftenDirItem[2] := NewItem('S~u~ppliers',   '', kbNone, cmStartOftenDirList2, hcDirectory, nil);
	OftenDirItem[3] := NewItem('~P~rospects',   '', kbNone, cmStartOftenDirList3, hcDirectory, nil);

	{Various sentence codes}
	SCodeCollection[scDirectoryCategory] :=
		New(PDirSCodeCollection, Init('KDIRCAT.SC', 'Directory Categories', CreateDirCatSCodeItem));
{	RegisterSCodeType(scDirectoryCategory, 'KDIRCAT.SC', 'Directory Categories', CreateDirCatSCodeItem);{}

	RegisterType(RDirCatScodeItem);

{$IFDEF kdirctry}
	RegisterTask(DesktopTasks, cmStartDirectoryList, 		@StartDirectoryList);
	RegisterTask(DesktopTasks, cmStartOftenDirList1, 		@StartOftenDirList1);
	RegisterTask(DesktopTasks, cmStartOftenDirList2, 		@StartOftenDirList2);
	RegisterTask(DesktopTasks, cmStartOftenDirList3, 		@StartOFtenDirList3);
	RegisterTask(DesktopTasks, cmStartSpecialDirList, 			@StartSpecialList);
{	RegisterTask(DesktopTasks, cmStartCatDirectoryList, @StartCatDirectoryList);{}

	RegisterRangeTask(DesktopTasks, cmDirectoryCategoryStart, cmDirectoryCategoryStart+100,
		@StartCommandCatDirectoryList);

	{--- "Find" ----}
	RegisterTask(DesktopTasks, cmFindDirectory, @FindDirectory);

	RegisterTask(StartupTasks, 5, @SetupDirectoryListMenu); {sets up dynamic menu}
{$ENDIF}

	NewFileAdmin(fiFullDirIdx, 'Directory Full Index',NewDirectoryFullIndex);
	NewFileAdmin(fiCatDirIdx, 'Directory Category Index',NewDirectoryCatIndex);
	NewFileAdmin(fiSpecialDirIdx, 'Special Directory Index',NewDirectorySpecialIndex);

	{Register tasks & commands for directory lists}
	RegisterWithList(lsDirectory,	mnView,  NewItem('~O~ptions',   '', kbNone, cmEditSetup, hcDirListOptions, nil),nil);
	RegisterWithList(lsDirectory,	'', 			NewItem('~D~ial','',kbNone, cmDial, hcDirListDial, nil),nil);

{$IFDEF kmaint}
	RegisterWithList(lsDirectory, mnEdit,  NewItem('~M~erge',    '',      kbNone,   cmMerge, hcDirMerge, nil),nil);
{$ENDIF}

	RegisterWithList(lsDirectory, '~S~how', NewItem('~N~otes', ksMore,  kbMore, cmMoreAbout, hcMoreAboutList, nil),nil);
	RegisterWithList(lsDirectory, '~S~how', NewItem('~H~istory', ksHistory,  kbHistory, cmHistory,   hcHistory, nil),nil);

	RegisterWithList(lsDirectory, mnPrint,
		NewLine(
		NewItem('L~a~bel', 		 ksLabel, kbLabel, cmPrintLabel, hcPrintDirLabel,
		NewItem('Defer Label', ksDeferLabel, kbDeferLabel, cmDeferLabel, hcDeferDirLabel,
	nil))),nil);

	RegisterWithList(lsDirectory, mnTag,
		NewLine(
		NewItem('~S~elected',  '', kbNone, cmTagSelected, hcTagging,
	nil)),nil);


	{$IFDEF kinvoice}
		RegisterWithList(lsDirectory, '~S~how', NewItem('B~i~lls', ksAccounts, kbAccounts, cmAccounts,   hcBillsList, nil),nil);
	{$ENDIF}

end.

