(*--------------------------------------------------------------------------*
 * DefIconer | Version 1.0 | released - 24.04.94                            *
 * Creates an appmenu from which the user can give files default icons      *
 * Lee Kindness - 8 Craigmarn Rd. Portlethen. ABERDEEN AB1 4QR SCOTLAND     *
 *                                                                          *
 * ProcessMsg.PAS                                                           *
 *                                                                          *
 *--------------------------------------------------------------------------*)

Function UpperStr(S : String) : String;
Var
     X : Byte;
Begin
  For X := 1 To Length(S) Do
    S[X] := UpCase(S[X]);
  UpperStr := S;
End;

Procedure HandleApp(AppPort : pMsgPort);

	
VAR
	mes     : pAppMessage;
	strList : pList;
	WBarg   : pWBArg;
	n       : byte;
	RemKey  : pRemember;
	node    : pStrNode;
	FName   : STRPTR;
	oldTT,oldDD,oldTW,oldDT : Pointer;
	olddir  : BPTR;
	dobj,defdobj : pDiskObject;
	OK      : Boolean;
	SR      : SearchRec;
	
Begin
	OK := False;
	mes := pAppMessage(GetMsg(AppPort));
	RemKey := NIL;
	While mes <> NIL do begin
		if mes^.am_NumArgs > 0 then begin
			StrList := AllocRemember(@RemKey, sizeof(tList), MEMF_CLEAR|MEMF_PUBLIC);
			NewList(pList(StrList));
			WBArg := mes^.am_ArgList;
			For n := 0 to mes^.am_NumArgs-1 do begin
			
				node := AllocRemember(@RemKey, sizeof(tStrNode), MEMF_CLEAR|MEMF_PUBLIC);
				node^.sn_Name := RetrieveStr(WBArg^.wa_Name);
				node^.sn_Lock := dupLock(WBArg^.wa_Lock);
				
				AddTail(pList(StrList),pNode(node));
				WBArg := Pointer(Long(WBArg) + sizeof(tWBArg));
			end;	
		end else StrList := NIL;

		ReplyMsg(pMessage(mes));
		{*********}
		
		if StrList <> NIL then begin
			node := pStrNode(StrList^.lh_Head);
			While (Node^.sn_Node.ln_Succ <> NIL) do begin

				IF V.Rexx then
					SendARexxCommand(V.REXXCMD, V.REXXPORT);
					
				FName := CStrConstPtrAR(@RemKey,node^.sn_Name);
				
				olddir := CurrentDir(node^.sn_Lock);

				if node^.sn_Name <> '' then begin
					dobj := GetDiskObject(FName);

					if (dobj <> NIL) and (dobj^.do_Type < 6) and (dobj^.do_Type <> 0) then begin
					
						{ExistingFile}
						defdobj := GetDefDiskObject(dobj^.do_Type);
					
						oldTT := defdobj^.do_ToolTypes;
						oldDD := defdobj^.do_DrawerData;
						oldTW := defdobj^.do_ToolWindow; { dont know what it is !!}
						oldDT := defdobj^.do_DefaultTool;
						
						defdobj^.do_ToolTypes := dobj^.do_ToolTypes; 
						defdobj^.do_DrawerData := dobj^.do_DrawerData;
						defdobj^.do_StackSize := dobj^.do_StackSize;
						defdobj^.do_ToolWindow := dobj^.do_ToolWindow;
						defdobj^.do_DefaultTool := dobj^.do_DefaultTool;
						defdobj^.do_CurrentX := dobj^.do_CurrentX;
						defdobj^.do_CurrentY := dobj^.do_CurrentY;
						
						OK := PutDiskObject(FName,defdobj);
						if NOT OK then 
							OK := PutDiskObject(FName,dobj);
						
						defdobj^.do_ToolTypes := oldTT;
						defdobj^.do_DrawerData := oldDD;
						defdobj^.do_ToolWindow := oldTW;
						defdobj^.do_DefaultTool := oldDT;
						
						FreeDiskObject(dobj);
						FreeDiskObject(defdobj);
					
					end else begin 
						If dobj = NIL then begin
							defdobj := GetDiskObjectNew(FName);
							if defdobj <> NIL then begin
								{Writeln('-NewFile');}
								OK := PutDiskObject(FName,defdobj);
								FreeDiskObject(defdobj);
							end;
						end else 
							FreeDiskObject(dobj);
					end;
						
				end else begin
				
					{ dir or disk }
					FName := CStrConstPtrAR(@RemKey, FExpandLock(node^.sn_Lock));
					dobj := GetDiskObject(FName);
					if Dobj <> NIL then begin
						{ Existing drawer icon }
						
						defdobj := GetDefDiskObject(dobj^.do_Type);
					
						oldTT := defdobj^.do_ToolTypes;
						oldDD := defdobj^.do_DrawerData;
						oldTW := defdobj^.do_ToolWindow; { dont know what it is !!}
						oldDT := defdobj^.do_DefaultTool;
						
						defdobj^.do_ToolTypes := dobj^.do_ToolTypes; 
						defdobj^.do_DrawerData := dobj^.do_DrawerData;
						defdobj^.do_StackSize := dobj^.do_StackSize;
						defdobj^.do_ToolWindow := dobj^.do_ToolWindow;
						defdobj^.do_DefaultTool := dobj^.do_DefaultTool;
						defdobj^.do_CurrentX := dobj^.do_CurrentX;
						defdobj^.do_CurrentY := dobj^.do_CurrentY;
						
						OK := PutDiskObject(FName,defdobj);
						if NOT OK then 
							OK := PutDiskObject(FName,dobj);
						
						defdobj^.do_ToolTypes := oldTT;
						defdobj^.do_DrawerData := oldDD;
						defdobj^.do_ToolWindow := oldTW;
						defdobj^.do_DefaultTool := oldDT;
						
						FreeDiskObject(defdobj);
						FreeDiskObject(dobj);
					
					end else begin
						FName := CStrConstPtrAR(@RemKey, FExpandLock(node^.sn_Lock)+'disk');
						dobj := GetDiskObject(FName);
						if Dobj <> NIL then begin
							{ Existing disk icon }
							
							defdobj := GetDefDiskObject(dobj^.do_Type);
					
							oldTT := defdobj^.do_ToolTypes;
							oldDD := defdobj^.do_DrawerData;
							oldTW := defdobj^.do_ToolWindow; { dont know what it is !!}
							oldDT := defdobj^.do_DefaultTool;
						
							defdobj^.do_ToolTypes := dobj^.do_ToolTypes; 
							defdobj^.do_DrawerData := dobj^.do_DrawerData;
							defdobj^.do_StackSize := dobj^.do_StackSize;
							defdobj^.do_ToolWindow := dobj^.do_ToolWindow;
							defdobj^.do_DefaultTool := dobj^.do_DefaultTool;
							defdobj^.do_CurrentX := dobj^.do_CurrentX;
							defdobj^.do_CurrentY := dobj^.do_CurrentY;
						
							OK := PutDiskObject(FName,defdobj);
							if NOT OK then 
								OK := PutDiskObject(FName,dobj);
						
							defdobj^.do_ToolTypes := oldTT;
							defdobj^.do_DrawerData := oldDD;
							defdobj^.do_ToolWindow := oldTW;
							defdobj^.do_DefaultTool := oldDT;
						
							FreeDiskObject(defdobj);
							FreeDiskObject(dobj);
							
						end else begin
							{ problem : is it a disk or drawer with no icon ?  }
							{ dont know how to figure out with AmigaDOS so use }
							{ HSPascal FindFirst()                             }
							FindFirst(FExpandLock(node^.sn_Lock),Directory,SR);
							If DosError <> 0 then begin
								{ It is a disk }
								dobj := GetDefDiskObject(WBDISK);
								if dobj <> NIL then begin
									OK := PutDiskObject(CStrConstPtrAR(@RemKey, FExpandLock(node^.sn_Lock)+'disk'),dobj);
									FreeDiskObject(dobj);
								end;
							end else begin
								{ It is a drawer }
								dobj := GetDefDiskObject(WBDRAWER);
								if dobj <> NIL then begin
									OK := PutDiskObject(CStrConstPtrAR(@RemKey, FExpandLock(node^.sn_Lock)),dobj);
									FreeDIskObject(dobj);
								end;
							end;
						end;
					end;
				end;
						
					
				olddir := CurrentDir(olddir);
				unlock(node^.sn_Lock);
						
				node := pStrNode(Node^.sn_Node.ln_Succ);
			end;
		end;
		
		{*********}
		
		mes := pAppMessage(GetMsg(AppPort));
	end;
	FreeRemember(@RemKey, True);
	If NOT OK then DisplayBeep(NIL);
end;
 
 
Procedure ProcessMessage(VAR IDPort, AppPort : pMsgPort);

VAR 
	Disable : Boolean;
	IDSig, IDCMPSig, AppSig, sigrcvd, BitFlags : LONG;
	Finished : Boolean;
	mes : pMessage;
	
begin
	IDSig := 0;
	IDCMPSig := 0;
	AppSig := 0;
	disable := false;
	finished := false;
	
	IDSig := 1 shl IDPort^.mp_SigBit;
	AppSig := 1 shl AppPort^.mp_SigBit;
	
	BitFlags := SIGBREAKF_CTRL_C OR IDSig OR IDCMPSig OR AppSig;
	While Not Finished do begin
		sigrcvd := Wait(BitFlags);
		if ((sigrcvd and IDSig)=IDSig) then begin
			mes := GetMsg(IDPort);
			ReplyMsg(mes);	
			Finished := True;
		end;
		if ((sigrcvd and AppSig)=AppSig) then begin
			HandleApp(AppPort);
		end;
		if ((sigrcvd and SIGBREAKF_CTRL_C)=SIGBREAKF_CTRL_C) then begin
			Finished := True;
		end; 
	end;
end;