{***********************************************************
 ***                 JIMMY INPUT LINE                    ***
 ***********************************************************}
{used as a parent for all jimmy-type input lines - eg inputdirectory, etc}
{$I compflgs}

{TInputJimmy provides a root object for all kinds of lines which accept
a jimmy, returning in getdata a disk ID pointer of longint.  Two descendants
here provide access to indexes and access to hooked lists}
unit InpJimmy;

INTERFACE

uses objects,
			tuijimmy,
			drivers, jimmys, tuiedit, inplist, tuilist;


{========= INPUT SELECTOR LINES ===============}
type
	PINputJimmy = ^TInputJimmy;
	TInputJimmy = object(TinputList)
		ID 		: longint; {The disk ID of the jimmy}
		Jimmy : PJimmy; 			{stores jimmy if it's ever needed, so we don't
														have to keep regetting from disk.  See GetJimmy method}
		TextChanged : boolean; {marker used to check whether name has been changed by user - ie
														whether it's the one brought in by a search and match, or one
														the user wants matched...}

		constructor Init(var Bounds : TRect;
											const NFieldLen : integer;
											const NlsType : word);
		destructor Done; virtual;

		{returns longint pointers}
		procedure GetData(var Rec); virtual;
		procedure SetData(var Rec); virtual;

		function GetJimmy : PJimmy;  {loads & returns jimmy from ID}

		function SearchOn : string; virtual; {converts data tzped to search string}
		function SuperSearchOn : string; virtual; {for super-search}

		function DataSize : word; virtual;
		function SetID : longint; virtual; {sets id from text entered, returns -1 if successful}
		procedure SetName; {virtual;  {sets name from id entered}
		procedure Clear; {clears data^, ID, jimmy, etc}

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

		function CreateList(Bounds : TRect) : PListWindow; virtual;
		function CreateSuperList(Bounds : TRect) : PListWindow; virtual;
		function ExecuteList(IdxRec : longint; const Super : Boolean) : word; virtual;

		function Valid(Command : Word) : boolean; virtual;

{$IFDEF fixit}
		procedure Draw; virtual; {adds ID # to display}
{$ENDIF}
	end;


type
	PInputIndexedJimmy = ^TInputIndexedJimmy;
	TInputIndexedJimmy = object(TInputJimmy)

		{for indexes}
		fiType : word;   {file type used in lists - ie index}
		SubIndexString : string[30]; {for subselections - eg only staff}
{		CommaTab : byte; {for things like directory where surname, forname is entered, and the
												tab is set to the spacing required for the index search.  See TInputDirectory
												and the setID below}

		SuperfiType : word; {for super lists - ie full lists}
		SuperlsType : word;

		constructor Init(Bounds : TRect;
											const NFieldLen : integer;
											const NfiType, NlsType : word; const NSubIndexString : string);
		destructor Done; virtual;

		function SearchOn : string; virtual;

		function SetID : longint; virtual; {sets id from text entered, returns -1 if successful, nearest index if not}
		function CreateList(Bounds : TRect) : PListWindow; virtual;
		function CreateSuperList(Bounds : TRect) : PListWindow; virtual;
	end;

type
	PInputHookedJimmy = ^TInputHookedJimmy;
	TInputHookedJimmy = object(TInputJimmy)

		DummyParent : PJimmy;
		DummySuperParent : PJimmy;
		hkType : byte;
		srRestrictor : word;

		constructor Init(Bounds : TRect;
											const NFieldLen : integer;
											const NhkType, NlsType,NsrRestrictor : word;
											const ParentID : longint);
		destructor Done; virtual;

		procedure SetParent(NewParentID : longint);
		procedure SetSuperParent(newParentID : longint);
		function SetID : longint; virtual; {returns false - no proc at the moment, have to list}
		function CreateList(Bounds : TRect) : PListWindow; virtual;
		function CreateSuperList(Bounds : TRect) : PListWindow; virtual;

		function Valid(Command : Word) : boolean; virtual;
	end;


	{==== BUTTON ACCESSOR ============}
	PAccessJimmyButton = ^TAccessJimmyButton;
	TAccessJimmyButton = object(TJimmyStoreButton)
		JimmyID : longint;
		Jimmy : PJImmy;
		srType : word;
		constructor Init(X,Y : longint; NTitle : string; NsrType : word; NParentJimmy : PJimmy);
		procedure SetParam(var Param : TJimmyInitParam); virtual;
		procedure SetJimmyFields; virtual;
		procedure Press; virtual;
		procedure HandleEvent(var Event : TEvent); virtual;
		procedure GetDAta(Var Rec); virtual;
		procedure SetDAta(Var Rec); virtual;
		function DataSize : word; virtual;
		procedure DrawState(Down: Boolean); virtual;
	end;

	{Similar to above, but gets the first instance of the srtype from
	the hktype list, rather than using getdata/setdata to edit}
	PAttachedJimmyButton = ^TAttachedJimmyButton;
	TAttachedJimmyButton = object(TAccessJimmyButton)
		hkType : word;
{		ChainOwningJimmy : PJimmy;{}
		constructor Init(X,Y : longint; NTitle : string; NsrType,NhkType : word);
{													NChainOwningJimmy : PJimmy);{}
		destructor Done; virtual;
		procedure GetDAta(Var Rec); virtual;
		procedure SetDAta(Var Rec); virtual;
		function DataSize : word; virtual;
	end;




IMPLEMENTATION

uses  minilib,
			indexes, jimindxs, jimhooks,
			tasks,
			help,
			messtext,
			tui,
			tuimsgs,
			views, app, dialogs,
			files, global;

	{***************************************************
	 ***           INPUT JIMMY ROOT                  ***
	 ***************************************************}
	constructor TInputJimmy.Init;
	begin
		inherited Init(Bounds,NFieldLen, NlsType);   {Size of field is 6 chars}

		FileAdmin(fiJimmys)^.LogOn;

		ID := -1;
		TextChanged := False;
		Jimmy := nil;

		EventMask := EventMask or evBroadCast; {so it can pick up jimmystored changes}
	end;

	destructor TInputJimmy.Done;
	begin
		if Jimmy<>nil then dispose(Jimmy, done);
		FileAdmin(fiJimmys)^.LogOff;
		inherited Done;
	end;

	procedure TInputJimmy.Clear;
	begin
		Data^ := '';
		SelectAll(False);
		SetID;
	end;

	{**********************************
	***         DATA I/O           ***
	**********************************}

	{SetData & GetData almost as Lint}
	procedure TInputJimmy.GetData(var Rec);
	begin
		Longint(Rec) := ID;
	end;

	procedure TInputJimmy.SetData(var Rec);
	begin
		ID := longint(Rec);
		SetName;
	end;

	function TInputJimmy.DataSize;
	begin DataSize := 4; end;

	function TInputJimmy.GetJimmy : PJimmy;
	var EditView : PView; {dummy for below}
	begin
		if (Jimmy<>nil) and (Jimmy^.RecNo<>ID) then begin
			{not the right one}
			dispose(Jimmy, done);
			Jimmy := nil;
		end;
		if Jimmy = nil then
			if ID>-1 then Jimmy := Jimmys.GetJimmy(ID) else Jimmy := nil;
		GetJimmy := Jimmy;
	end;

	procedure TInputJimmy.SetName;
	begin
		if ID < 0 then
			Data^ := ''
		else begin
			if GetJimmy = nil then begin
				Data^ := '??'+N2Str(ID)+'?';  {Hole, etc}
				with JimmyStream^ do if Status<>stOk then ErrorMsg('TInputJimmy.SetName');
			end else begin
				Data^ :=Copy(GetJimmy^.GetName(naDisplay,0),1,Maxlen);
			end;
		end;
		TextChanged := False; {name now same as ID}

		{if jimmy has been deleted, clear ID and leave text as name to be found}
		{$IFNDEF fixit}
		if (GetJimmy<>nil) and (GetJimmy^.Deleted) then begin
			Data^ := FirstWord(Data^);
			ID := -1;
			TextChanged := True;
		end;
		{$ENDIF}

		SelectAll(True); {also does DrawView;}
	end;

	procedure TInputJimmy.SetChanged; {called every time key pressed, etc that causes a data^ change}
	begin
		inherited SetChanged;
		if not IgnoreChanges then TextChanged := True;
	end;


	function TInputJimmy.SetID : longint; {returns -1 if successful}
	begin
		SetID := -1;
{leave as is, for eg diary repeaters where line can be a route to
editing inputjimmy but not changing id		ID := -1;
		SetName;{}
	end;



{***********************************
 ***       HANDLE EVENT          ***
 ***********************************}
procedure TInputJimmy.HandleEvent(var Event : TEvent);
var EditJimmy : PJimmy;
begin

	{somewhere a jimmy has been stored, so check if it is the same recno as
	the one in view, and if so update.  We have to allow for the fact that
	it might be the *same* heap entry too, as used in the belows edit}
	if (Event.What = evBroadCast) and (Event.Command = cmJImmyStored) and
		(PJimmyStoredInfo(Event.InfoPtr)^.Jimmy^.RecNo = ID) then begin
			if Jimmy<>nil then dispose(Jimmy, done);
			Jimmy := nil; {so it gets reloaded}
			SetName; Draw;
			ForceLink; {in case the changes to the jimmy have any changes elsewhere}
	end;

	{--- edit item specified -----}
	if (Event.What = evKeyBoard) and (Event.KeyCode = kbChange) then begin
		if (not TextChanged) and (GetJimmy<>nil) then begin
			{if text not changed since last match, and not blank, then get & edit}
			{this view is modal, and as it may call the above cmjimmystored, we
				need to clear the jimmy *before* we call the edit}
			{We need to be slightly careful here of locks, so to be safe, let's
			re-get the jimmy if it needs edited}
			EditJimmy := Jimmys.GetJimmy(ID);
			if Owner^.GetState(sfModal) then
				EditJimmy^.Edit(@Self, @Self) {make modal}
			else
				EditJimmy^.Edit(@Self, nil); {no need to set acceptor link as above jimmystored will handle changes}
		end else
			{o/w normal list}
			ExecuteList(-1, False);

		ClearEvent(Event);
	end;

	{--- General cmAcceptJImmy -----}
	{override by trapping before doing inherited Handleevent in descendants}
	if (Event.Command = cmAcceptJimmy) and GetState(sfSelected) then begin
		ID := PLongint(Event.InfoPtr)^; {dereference disk ID from message pointer}
		if Jimmy<>nil then begin
			dispose(Jimmy, done);
			Jimmy := nil; {force reget}
		end;
		SetName;
		{validate entry (eg correct sex etc)}
		if not Valid(cmAccept) then begin
			{make sure that the valid(cmAccept) does *not* focus on the inputline
			if there's an error}
			Clear; {clear}
{			ClearEvent(Event); {set to handled}
		end else begin
			SelectAll(True);
			ClearEvent(Event); {set to handled}
		end;
		Drawview;
		Forcelink;
	end;

	inherited HandleEvent(Event);

	{--- Run the Jimmy selection list ----}
	if ((Event.What = evCommand) and (Event.Command = cmList)) and
			 ((ListOptions and loAllowList)>0) then begin
			ExecuteList(-1, False);
			ClearEvent(Event);
	end;

	if ((Event.What = evCommand) and (Event.Command = cmSuperList)) and
			 ((ListOptions and loAllowSuperList)>0) then begin
			ExecuteList(-1, True);
			ClearEvent(Event);
	end;

end;


{====== EXECUTE LIST =========================}
{Override "CreateList" to use different types of list descendants}
function TInputJimmy.CreateList;
begin
	CreateList := nil;
end;

function TInputJimmy.CreateSuperList;
begin
	CreateSuperList := CreateList(Bounds);
end;



function Tinputjimmy.SearchOn;
begin
	SearchOn := ucase(Data^);
end;

function TInputJimmy.SuperSearchOn;
begin
	SuperSearchOn := ucase(Data^);
end;

function TInputJimmy.ExecuteList;
var  R : TRect;
		 ListWindow : PListWindow; {}
		 ListOrig : TPoint;

begin
	{Set size & pos so that first line of list is over inputline}
	MakeGlobal(Origin, ListOrig);
	R.XYLD(ListOrig.X-1, ListOrig.Y-3,55,15);

  {botch? move...}
  R.A.X := R.A.X - Origin.X; {}
  R.A.Y := R.A.Y - Origin.Y;

  {clip & ensure it will be visible}
	if R.B.Y>Desktop^.Size.Y then R.B.Y := Desktop^.Size.Y;
	CheckOnDesktop(R); {moves to on-screen}

	if Super then
		ListWindow := CreateSuperList(R)
	else
		ListWindow := CreateList(R);

	if ListWindow = nil then begin
		ExecuteList := cmCancel;
		exit;
	end;

	ListWindow^.List^.AcceptorLink := @Self; {make sure cmaccept gets passed directly to self}

	{if idxrec passed, focus on that}
	if IdxRec>-1 then begin
		ListWindow^.List^.FindOKItemNo(IdxRec);
		ListWindow^.List^.FocusItem(IdxRec)
	end else
		{If something entered, move to that}
		if (DelSpace(Data^)<>'') then ListWindow^.List^.FocusText(SearchOn);

	{Make modal & input}
	ExecuteList := Desktop^.ExecView(ListWindow);

	Dispose(ListWindow, Done);
end;


{==== VALIDATION ===============================}
{Check at end of input to see if OK }
{previously it used to do the search here too, but this is not really "correct"
and also seemed to use a vast amount of stack.  So this *does* do a search
on text entered if TextChanged, but otherwise is here just to validate the
kind of entry - eg for male/female checking.  If TextChanged and no match
found, then DoList is set}
function TInputJimmy.Valid(Command: Word) : boolean;
var V : boolean;
		IdxRec : longint;

begin
	V := inherited Valid(Command);

	if V and DoValidFor(Command) then begin{}

		if TextChanged then begin
			{check for match & set ID num}
			IdxRec := SetID; {returns -1 if OK, nearest match if not}

			if (idxRec<>-1) then V := False;	{no match found, so not valid}
		end;

		if V and (Copy(Data^,1,2) = '??') then V := False;  {Whatever, has gone wrong}

		{if not valid (and not just doing a forcelink validation}
		if not V and (Command<>cmForceLink) then begin
			if Command<>cmAccept then Focus;
			if ListOptions and loAllowList >0 then begin
				WarningBleep;
				DoList := True
			end else
				InputWarning('Cannot exactly find '+Data^, HelpCtx);
		end;

	end;

	Valid := V;
end;


{$IFDEF fixit}
procedure TInputJimmy.Draw;
begin
	inherited Draw;
	WriteStr(size.x-length(N2Str(ID)),0, N2Str(ID), 4);                             {Little up arrow marker}
end;
{$ENDIF}




	{***************************************************
	 ***           INPUT INDEXED JIMMY               ***
	 ***************************************************}

constructor TInputIndexedJimmy.Init;
begin
	inherited Init(Bounds,NFieldLen, NlsType);   {Size of field is 6 chars}

	fiType := NfiType;

	SubIndexString := NSubIndexString;

	FileAdmin(fiType)^.LogOn;

{	CommaTab := 0;{}

	SuperfiType := 0;
	SuperlsType := 0; {set by desendants}

end;

destructor TInputIndexedJimmy.Done;
begin
	FileAdmin(fiType)^.LogOff;
	inherited Done;
end;


function TInputIndexedJimmy.SearchOn;
begin
	SearchOn := SubIndexString+inherited SearchOn;
end;


	{===== LISTING & SEARCHING =============}
	{Sets ID number from text typed in, listing if duplicate matches of
		text or no match}
	{Can also test TextChanged for boolean check on if successful}
	function TInputIndexedJimmy.SetID : longint; {returns index of nearest match, -1 if successful}
	var I : integer;
			IdxRec, HoleRec,WorkID : longint;

	begin
		SetID := -1;

		{If nothing typed in}
		if delspace(Data^)='' then begin
			if ID<>-1 then begin
				{clear}
				if Jimmy<>nil then dispose(Jimmy, done);
				Jimmy := nil;
				ID := -1;
				TextChanged := False; {now matches}
				SetID := -1;
			end
		end else begin

			{Look through index to find match}
			IdxRec := -1;

			{comma separators - leave for search on}
{			if (pos(',',S^)>0) and (CommaTab<>0) then S^ := PadSpaceR(Copy(S^,1,pos(',',S^)-1),CommaTab)+Copy(S^,pos(',',S^)+1,256);{}

			{find match}
			I := PIndexStream(Stream(fiType))^.FindMatch(SearchOn, IdxRec, Holerec, WorkID);

			{no match found . check super list (eg full directory)}
			if (I=-1) and ((ListOptions and loCheckSuper)>0) and (SuperfiType<>0) then begin
					FileAdmin(SuperfiType)^.LogOn;
					I := PIndexStream(Stream(SuperfiType))^.FindMatch(SuperSearchOn, IdxRec, HoleRec, WorkID);
					FileAdmin(SuperfiType)^.LogOff;
			end;

			if (I=0) or ((I=+1) and (ListOptions and loGetFirst>0)) then begin
				{one exact match found, or many found & logetfirst set}
				ID := WorkID;
				SetName; {set full name}
				SetID := -1; {successful}
			end else
				{none or duplicates found}
			SetID := IdxRec;  {nearest match}
		end;
	end;



{====== EXECUTE LIST =========================}
{Override "CreateList" to use different types of list descendants}
function TInputIndexedJimmy.CreateList;
begin
	CreateList := New(PListWindow, init(
		Bounds, GetMessage(msListTitles, lsType),
		New(PIndexedJimmyListView, init(
			Bounds, lsType, fiType, SubIndexString
		))
	));
end;

function TInputIndexedJimmy.CreateSuperList;
begin
	CreateSuperList := New(PListWindow, init(
		Bounds, GetMessage(msListTitles, SuperlsType),
		New(PIndexedJimmyListView, init(
			Bounds, SuperlsType, SuperfiType, ''
		))
	));
end;




{************************************************************
 ***                  HOOKED JIMMY                        ***
 ************************************************************}


{===== INIT ==========}
constructor TInputHookedJimmy.Init;
begin
	inherited Init(Bounds,NFieldLen, NlsType);   {Size of field is 6 chars}

	SetParent(ParentID);
	SetSuperParent(-1);

	hkType := NhkType;
	srRestrictor := NsrRestrictor;

	ListOptions := ListOptions or loAutoList; {always automatically list}

	FileAdmin(fiHooks)^.LogOn;
end;

destructor TInputHookedJimmy.Done;
begin
	if DummyParent<>nil then dispose(DummyParent, done);
	if DummySuperParent<>nil then dispose(DummySuperParent, done);
	FileAdmin(fiHooks)^.LogOff;
	inherited Done;
end;


procedure TInputHookedJimmy.SetParent(NewParentID : longint);
begin
	{set up dummy parent jimmy.  It doesn't contain any info, but it allows
	us to store/update the correct pointers on the disk, without worrying about
	altering data in use elsewhere in memory (ie parentjimmy) and besidees
	which we don't need any other info}
	{Actually, we could really do with the real thing so that when we do
	a list it's got a proper name (not just "addresses of")}

	if DummyParent<>nil then dispose(DummyParent, done);

	if NewParentID<>-1 then
		DummyParent := Jimmys.GetJimmy(NewParentID)
	else
		DummyParent := nil;

end;

procedure TInputHookedJimmy.SetSuperParent(NewParentID : longint);
begin
	if DummySuperParent<>nil then dispose(DummySuperParent, done);

	if NewParentID<>-1 then begin
		DummySuperParent := Jimmys.GetJimmy(newParentID);
		ListOptions := ListOptions or loAllowSuperList;
	end else begin
		DummySuperParent := nil;
		ListOptions := ListOptions and not loAllowSuperList;
	end;
end;


function TInputHookedJimmy.SetID;
begin
	SetID := inherited SetID; {SetID := -1; {should search through chain looking for match...}
end;


function TInputHookedJimmy.CreateList(Bounds : TRect) : PListWindow;
begin
	if DummyParent = nil then begin
		PauseMessage('Input','No Owner Set',hcInternalErrorMsg);
		CreateList := nil;
	end else
		CreateList := NewJImmyHookWindow(
										Bounds,
										lsType,
										srRestrictor,
										hkType,
										DummyParent,
										nil);
end;

function TInputHookedJimmy.CreateSuperList(Bounds : TRect) : PListWindow;
begin
	if DummySuperParent = nil then begin
		CreateSuperList := nil;
	end else
		CreateSuperList := NewJImmyHookWindow(
										Bounds,
										lsType,
										srRestrictor,
										hkType,
										DummySuperParent,
										nil);
end;


function TInputHookedJimmy.Valid;
var V : boolean;
begin
	V := inherited Valid(Command);
	if V and DoValidFor(Command) then begin{}
		if (srRestrictor<>0) and (GetJimmy<>nil) and (GetJimmy^.srtype<>srRestrictor) then begin
			Focus;
			InputWarning('Wrong type selected', HelpCtx);
			V := False;
		end;
	end;
	Valid := V;
end;


{********************************************
 **           JIMMY ACCESS BUTTON         ***
 ********************************************}
{used to access/create a jimmy, tied directly to an object}
{Parent jimmy is the one associated with the parent box, which
might need to be stored before this one is created}
constructor TAccessJimmyButton.Init;
begin
	inherited Init(X,Y, NTitle, cmNone, bfNormal, NParentJimmy);
	JimmyID := -1;
	Jimmy := nil;
	srType := NsrType;
	EventMask := EventMAsk or evBroadCast;
end;

procedure TAccessJimmyButton.GetData;
begin
	longint(Rec) := JimmyID;
end;

procedure TAccessJimmyButton.SetData;
begin
	JimmyID := longint(REc);
end;

function TAccessJimmyButton.DataSize;
begin DataSize := 4; end;

procedure TAccessJimmyButton.HandleEvent;
begin
	{ignore changes of command set as it enables the buttons}
	if ((Event.What=evBroadCast) and (Event.COmmand = cmCommandSetChanged)) then
		exit;

	inherited HandleEvent(Event);

	{may not be selected, so check Jimmy instead}
	if (Event.What = evBroadCast) and (Event.Command = cmAcceptJimmy) and (Jimmy<>nil) then begin
		JimmyID := PLongint(Event.InfoPtr)^; {dereference disk ID from message pointer}
		ClearEvent(Event); {set to handled}
	end;
end;

procedure TAccessJimmyBUtton.SetParam(var Param : TJimmyInitParam);
begin
	with Param do begin
		ListVIew := nil;
		ForWho 		:= PJimmyEditBox(Owner)^.Jimmy^.RecNo;
		FocusedID := -1;
		FocusedParentID := -1;
	end;
end;

{used after creating access jimmy to set any fields from owner/etc}
procedure TAccessJimmyButton.SetJimmyFields;
begin end;


procedure TAccessJimmyButton.Press;
var Param : TJimmyInitParam;
begin
	{--- check owner is saved ---}
	{so we have something to hook to}
	if (PJimmyEditBox(Owner)^.Jimmy^.RecNo=-1) then
		inherited Press; {stores}

	if OwnerValid = 0 then begin
		if Owner^.Valid(Command) then OwnerValid := +1 else OwnerValid := -1;
	end;

	if OwnerValid=+1 then begin
		DrawState(True);
		if JimmyID = -1 then begin
			{--- create new jimmy -------}
			SetParam(Param);
			JImmy := Create(srType, @Param);
			SetJimmyFields;
		end else begin
			Jimmy := GetJimmy(JimmyID);
		end;

		if Jimmy<>nil then
			Jimmy^.Edit(@Self, @Self); {will be modal as acceptor link is set}

		Jimmy := nil;

		DrawView; {put marker back in}
	end;
end;

procedure TAccessJimmyButton.DrawState;
begin
	inherited DrawState(Down);
	if JimmyID<>-1 then
		if Down then WriteChar(2,0, #4, 1, 1) else WriteChar(1,0,#4,1,1);
end;

{********************************************
 **           JIMMY ACCESS BUTTON         ***
 ********************************************}
{used to access/create a jimmy, tied directly to an object}
constructor TAttachedJimmyButton.Init;
begin
	inherited Init(X,Y, NTitle, NsrType, nil);
	hkType := NhkType;
	FileAdmin(fiHooks)^.LogOn;
end;

destructor TAttachedJimmyButton.Done;
begin
	FileAdmin(fiHooks)^.LogOff;
	inherited Done;
end;

procedure TAttachedJimmyButton.GetData;
begin end;

procedure TAttachedJimmyButton.SetData;
var HookRec : PLongint;
begin
	{set jimmyid}
	PJimmyEditBox(Owner)^.Jimmy^.GetHookOn(hkType, HookRec);
	if HooKRec<>nil then
		JimmyID := HookFile^.FindFirst(HookRec^, srType);
end;

function TAttachedJimmyButton.DataSize;
begin DataSize := 0; end;



end.
