(**************************************************************************

:Remark.			Format: ein TAB in jeder 3. Spalte: ..tab..tab..tab..


:Program.		Req		

:Contents.		Produce a file/directory requester and call a cli command
:Contents.		with the result of the requester as argument(s).

:Bugs.			"Shit happens." (Murphy)

:Bugs.			The use of the filerequester as directory requester (i. e. not
:Bugs.			to select a file) results in the loss of 48 bytes of memory and
:Bugs.			a not released lock on the selected directory. Therefore the use
:Bugs.			of the DIR option is highly recommended if a directory is to be
:Bugs.			selected. This seems to be a bug in the asl.library V40, not in Req.


:Copyright.		Freeware---you may copy and use it, but all rights remain
:Copyright.		at the author

:Author.			Thomas Ansorge

:Address.		Dinkelackerring 55, 67435 Neustadt, Deutschland, Europa


:Language.		Modula-2

:Translator.	M2Amiga V4.3 (deutsch)


:History.		1.0 as of 30-Apr-1995: seems to work...

:History.		1.1 as of 10-Jun-1995: switch ASK added

:History.		1.2 as of 23-Jun-1995: SystemTagList () instead of Execute ()

:History.		1.3 as of 02-Jul-1995: sysUserShell now with dosTRUE (0 before)


**************************************************************************)


MODULE Req;

(*$ "\n nicht vergessen: 40000 Bytes Stack!\n\n" *)

FROM Arts IMPORT BreakPoint, returnVal, Terminate;

FROM ASCII IMPORT nul;

FROM AslD IMPORT aslFileRequest, FileRequester, FileRequesterPtr, FRFlag1, FRFlag1Set, FRFlag2, FRFlag2Set, tfrTitleText, tfrDoSaveMode, tfrDoMultiSelect, tfrDoPatterns, tfrDrawersOnly, tfrFlags1, tfrFlags2;

FROM AslL IMPORT AllocAslRequest, AslRequest, FreeAslRequest;

FROM DosD IMPORT dosFALSE, dosTRUE, fail, RDArgsPtr, SysTags;

FROM DosL IMPORT AddPart, dosVersion, Execute, FreeArgs, IoErr, PrintFault, ReadArgs, SystemTagList;

FROM String IMPORT ANSICap, Concat, ConcatChar, Copy, FirstPos, LLength, noOccur;

FROM SYSTEM IMPORT ADR, CAST, TAG;

FROM Terminal IMPORT BusyRead, Read, WriteLn, WriteString;

FROM UtilityD IMPORT tagEnd;

FROM WorkbenchD IMPORT WBArg;

(* --------------------------------------------------------------------- *)

CONST
	prog_str = "Req 1.3/";
	date_str = "(02.07.95)";

	(*$ IF M68881 OR M68040 *)
		ver_str = prog_str + "68020+FPU " + date_str;
	(*$ ELSIF M68020 *)
		ver_str = prog_str + "68020 " + date_str;
	(*$ ELSIF M68010 *)
		ver_str = prog_str + "68010 " + date_str;
	(*$ ELSE *)
		ver_str = prog_str + "68000 " + date_str;
	(*$ ENDIF *)
	
	ver_ptr = ADR ("$VER: " + ver_str);

CONST
	template = "COMMAND/A,SAVE/S,DIR/S,SHOW/S,ASK/S";
	
CONST
	dos_min_version = 37;
	
TYPE
	Str = ARRAY [0..31999] OF CHAR;
	StrPtr = POINTER TO Str;
	
	ArgsArray = RECORD
		command: StrPtr;
		save: LONGINT;
		dir: LONGINT;
		show: LONGINT;
		ask: LONGINT;
	END; (* RECORD ArgsArray *)

VAR
	(* Pointer *)
	rdargs_ptr: RDArgsPtr;

	(* 32bit stuff *)
	args_array: ArgsArray;
	str: Str;
	tag_list: ARRAY [1..4] OF LONGINT;
	
	(* other *)
	c: CHAR;

(* ------------------------------------------------------------------------------ *)

(*
DoRequest bringt den File-/Dir-Requester und füllt str mit den zurückgegebenen Argumenten.
Wenn der Benutzer Ok im Requester anwählt, wird TRUE zurückgegeben, sonst FALSE.

Wichtig: \comm{dir} und \comm{save} dürfen nicht beide gleichzeitig \comm{TRUE} sein (wird 
abgefangen, indem ggf.\ \comm{save := FALSE} gesetzt wird).
*)

PROCEDURE DoRequest (dir, save: BOOLEAN; VAR str: Str): BOOLEAN;

	TYPE
		TagList = ARRAY [1..2 * 6] OF LONGINT;
		
		WBArgArrayPtr = POINTER TO ARRAY [0..MAX (INTEGER)] OF WBArg;

	VAR
		(* Pointer *)
		req_ptr: FileRequesterPtr;
		
		(* other 32bit stuff *)
		taglist: TagList;
		
		(* other *)
		flags1_set: FRFlag1Set;
		flags2_set: FRFlag2Set;
		i: INTEGER;
		ok: BOOLEAN;

	(* --------------------------------------------------------------------------- *)
	
	(*$ CopyDyn := FALSE *)
	
	PROCEDURE ConcatName (VAR str: ARRAY OF CHAR; dir, file: ARRAY OF CHAR): BOOLEAN;
		
		VAR
			name: Str;
		
		BEGIN (* Funktion ConcatName *)
			Copy (name, dir);

			IF AddPart (ADR (name), ADR (file), SIZE (name)) THEN
				IF (LLength (str) + LLength (name) + 3) < SIZE (str) THEN
					ConcatChar (str, " ");
					
					IF FirstPos (name, 0, " ") = noOccur THEN
						Concat (str, name);
					
					ELSE (* IF FirstPos (str, 0, " ") = noOccur THEN *)
						ConcatChar (str, "\"");
						Concat (str, name);
						ConcatChar (str, "\"");
					END; (* IF FirstPos (str, 0, " ") = noOccur THEN ELSE *)
					
					RETURN TRUE;
				END; (* IF (Length (str) + Length (name) + 3) < SIZE (str) THEN *)
			END; (* IF AddPart (ADR (name), ADR (file), SIZE (name)) THEN *)
			
			RETURN FALSE;
		END ConcatName; (* Funktion *)

	(* --------------------------------------------------------------------------- *)
		
	BEGIN (* Funktion DoRequest *)
		ok := FALSE;
	
		IF save THEN
			save := NOT dir;
		END; (* IF save THEN *)
	
(*
Für diese Flags gibt es eigene TagItems (unten in Kommentarklammern), aber leider erst
ab V38 der Library. So geht es auch von Anfang an.
*)
	
		flags1_set := FRFlag1Set {frDoPatterns};
		
		IF save THEN
			INCL (flags1_set, frDoSaveMode);
		END; (* IF save *)
		
		IF NOT save AND NOT dir THEN
			INCL (flags1_set, frDoMultiSelect);
		END; (* IF NOT save AND NOT dir THEN *)
		
		IF dir THEN
			flags2_set := FRFlag2Set {frDrawersOnly};
		END; (* IF dir THEN *)

		req_ptr := AllocAslRequest (aslFileRequest, TAG (taglist,
			tfrTitleText, ADR (str),
			tfrFlags1, flags1_set,
			tfrFlags2, flags2_set,
			(*tfrDoSaveMode, save,*)
			(*tfrDoMultiSelect, (NOT save AND NOT dir),*)
			(*tfrDoPatterns, TRUE,*)
			(*tfrDrawersOnly, dir,*)
			tagEnd, 0));
			
		IF req_ptr # NIL THEN
			ok := AslRequest (req_ptr, NIL);
			
			IF ok THEN
				IF req_ptr^.numArgs = 0 THEN
					ok := ConcatName (str, CAST (StrPtr, req_ptr^.dir)^, CAST (StrPtr, req_ptr^.file)^);
				
				ELSE (* IF req_ptr^.numArgs = 0 THEN *)
					(* Multiselect! *)
					
					FOR i := 0 TO req_ptr^.numArgs - 1 DO
						ok := ConcatName (str, CAST (StrPtr, req_ptr^.dir)^, CAST (StrPtr, CAST (WBArgArrayPtr, req_ptr^.argList)^ [i].name)^);
					END; (* FOR i := 0 TO req_ptr^.numArgs - 1 DO *)
				END; (* IF req_ptr^.numArgs = 0 THEN ELSE *)
					
				IF NOT ok THEN
					WriteString (ver_str);
					WriteString (" failed: argument string overflow, more than 32000 chars!");
					WriteLn;
					
					returnVal := 20;
				END; (* IF NOT ok THEN *)
			END; (* IF ok THEN *)
			
			FreeAslRequest (req_ptr);
		END; (* IF req_ptr # NIL *)
		
		RETURN ok;
	END DoRequest; (* Funktion *)

(* ------------------------------------------------------------------------------ *)
(* ------------------------------------------------------------------------------ *)

BEGIN (* Programm Req *)
	IF dos_min_version <= dosVersion THEN
		rdargs_ptr := ReadArgs (ADR (template), ADR (args_array), NIL);
		
		IF rdargs_ptr = NIL THEN
			IF PrintFault (IoErr (), ADR (ver_str)) THEN END;
			
			returnVal := fail;
			Terminate ();
		END; (* IF rdargs_ptr = NIL THEN *)
		
		IF args_array.ask # dosFALSE THEN
			args_array.show := dosTRUE;
		END; (* IF args_array.ask # dosFALSE *)
		
		Copy (str, args_array.command^);
		
		IF DoRequest (args_array.dir # 0, args_array.save # 0, str) THEN
			IF args_array.show # dosFALSE THEN
				WriteString (str);
				WriteLn;
				
				IF args_array.ask # dosFALSE THEN
					WriteString ("ok? y/n: ");
					Read (c);
					
					IF ANSICap (c) # "Y" THEN
						Terminate ();
					END; (* IF ANSICap (c) # "Y" *)
				END; (* IF args_array.ask *)

				WriteLn;
			END; (* IF args_array.show # 0 THEN *)
			
			IF SystemTagList (ADR (str), TAG (tag_list, sysUserShell, dosTRUE, tagEnd, 0)) # 0 THEN
				IF PrintFault (IoErr (), 0) THEN END;
			END; (* IF SystemTagList (ADR (str), TAG (sysUserShell, 0, tagEnd, 0)) # 0 THEN *)
			
			(*IF Execute (ADR (str), NIL, NIL) # 0 THEN END;*)
		END; (* IF DoRequest (args_array.dir # 0, args_array.save # 0, str) THEN *)
		
	END; (* IF dos_min_version <= dosVersion THEN *)

CLOSE; (* ----------------------------------------------------------------------- *)

(*
Wir haben oben ein Zeichen mit \comm{Read} gelesen. Es sind wahrscheinlich noch mehr da
(zumindest ein RETURN), die wir jetzt lesen, um den Eingabekanal zu leeren.
*)

	WHILE c # nul DO
		BusyRead (c);
	END; (* WHILE c # nul *)
	
	IF rdargs_ptr # NIL THEN
		FreeArgs (rdargs_ptr);
		rdargs_ptr := NIL;
	END; (* IF rdargs_ptr # NIL THEN *)
END Req. (* Programm *)