--
separate(COMMAND_PROCESSOR)
procedure CREATE_SOURCE(FILE : in out DYN_STRING; EXT : in out DYN_STRING;
			UNIT_ID : in string; DIR : in string) is
--+----------------------------------------------------------------------
--
--	Unit Type : procedure type
--	Unit Name : CREATE_SOURCE.ADA
--	Version   : V01.0A
--
--	Author : Stephen R. Rainier	       Date : 10/11/85
--
--	Purpose :  To create a new Ada source file in the proper format
--		   and spawn EDT.
--
--	Parameters :
--
--	Name		Mode(I,O,IO)	Type/Subtype		Description
--	----		------------	------------		------------
--	FILE		    IO		DYN_STRING		name of file
--	EXT		    IO		DYN_STRING		file extension
--	UNIT_ID		    I		string			UNIT_TYPE string
--	DIR		    I		string			UIC of EDTINI
--
--	Modifications :
--
--	Name			Date		Description of Change
--	----			----		---------------------
--
--
--	Packages "WITH"ed :system, DYNAMIC_STRING, FILE_ACCESS, text_io
--				calendar
--
--	Procedure/Function "CALL"s :
--
--
--	Exceptions :
--
--	Name			Handled/Raised		Description
--	----			--------------		-----------
--
--
--	Side Effects :
--
--
--	Comments :
--
--%----------------------------------------------------------------------

--
--		Declarations
--
  type UNIT_TYPE is (S, B, P, F, G, N, Q, X);
  FILENAME, LINE : DYN_STRING;
  START : integer := 0;
  CHAR : character;
  ONE_STR : string(1..1) := " ";
  CUR_TIME : time;
  HEADER, TMP_FILE : file_type;
  CR : string(1..2) := (1 => character'val(8#15#), 2 => character'val(8#12#));
  UNIT : UNIT_TYPE := X;
  UNIT_STR : array(UNIT_TYPE) of DYN_STRING := 
	(S => D_STRING("package"), B => D_STRING("package body"),
	 P => D_STRING("procedure"), F => D_STRING("function"),
	 G => D_STRING("generic" & CR & CR & "package"), N => D_STRING(""),
	 Q => D_STRING(""), X => D_STRING(""));
  PROCESS_ID : system.unsigned_longword := 0;
  STATUS, COMPLETION_STATUS : system.unsigned_longword := 0;
begin
  FILENAME := FILE & EXT;	-- Create a filename --
  if (STR(EXT) = ADA_EXT) or (STR(EXT) = "") then	-- Is it an Ada unit? --
    if LENGTH(EXT) = 0 then EXT := D_STRING(ADA_EXT); end if;
    FILENAME := FILE & EXT;	-- Create a filename --
-- --		Determine whether the file exists 			-- --
    begin
      open(TMP_FILE, IN_FILE, STR(FILENAME));	-- No error if file exists --
      close(TMP_FILE);				-- If file exists, close --
    exception
      when name_error => 			-- If no file, create one --
      begin
      -- copy the header to the new Ada unit and edit it --
	CUR_TIME := clock;			-- Need to fill in date --
	if UNIT_ID /= "" then
	begin
	  ONE_STR(1) := UNIT_ID(1);
	  UNIT := UNIT_TYPE'value(ONE_STR);	-- figure the type
	exception
	  when constraint_error => UNIT := X; 	-- default if not legal --
	end;
	end if;
-- --		Loop waiting to determine Ada unit type or Quit 	-- --

	while UNIT = X loop			-- wait til get a unit type --
	begin
	  put("Enter [S]package spec, [B]package body, [P]rocedure, "&
		      "[F]unction, [G]eneric,"); new_line;
	  put(" [N]o format, or [Q]uit :");
	  get(CHAR); new_line;			-- Get the Ada unit type --
	  ONE_STR(1) := CHAR;
	  UNIT := UNIT_TYPE'value(ONE_STR);	-- get unit type --
	exception
	  when constraint_error => UNIT := X; 	-- default if not legal --
	end;
	end loop;

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- --		Form the proper header for the new Ada unit		-- --

	if UNIT /= Q then			-- continue if not Quit --

	  if UNIT = S or UNIT = G then		-- make a specification name --
	    FILENAME := FILE & D_STRING("_") & EXT;
	  end if;

	  create(TMP_FILE, OUT_FILE, STR(FILENAME)); -- create the file --

	  if UNIT /= N then			-- if no format, skip this --
	    open(HEADER, IN_FILE, "DBC4:[C_SITE.DATA]ADA_SOURCE.HDR");
	    reset(HEADER);

	    while not end_of_file(HEADER) loop	-- read in header --
	      LINE := D_STRING("");

	      while not end_of_line(HEADER) loop -- read in each line --
		get(HEADER, CHAR);
		LINE := LINE & D_STRING(CHAR);
	      end loop;
	      skip_line(HEADER);			-- got a line --
	      START := INDEX(LINE, D_STRING("####"),1);	-- unit type --
	      if START >= 1 then
		LINE := SUBSTRING(LINE, 1, START-1) & UNIT_STR(UNIT) &
			SUBSTRING(LINE, START+4, LENGTH(LINE) - (START+3));
	      end if;
	      START := INDEX(LINE, D_STRING("$$$$"),1);	-- unit name --
	      if START >= 1 then 
		LINE := SUBSTRING(LINE, 1, START-1) & FILE &
			SUBSTRING(LINE, START+4, LENGTH(LINE) - (START+3));
	      end if;
	      START := INDEX(LINE, D_STRING("@@@@"),1);	-- creation date --
	      if START >= 1 then
		LINE := SUBSTRING(LINE, 1, START-1) & 
			D_STRING(integer'image(month(CUR_TIME))) & 
			D_STRING("/") & D_STRING(integer'image(day(CUR_TIME))) &
			D_STRING("/") & 
			D_STRING(integer'image(year(CUR_TIME)-1900)) &
			SUBSTRING(LINE, START+4, LENGTH(LINE) - (START+3));
	      end if;
	      if (INDEX(LINE, D_STRING("begin"), 1) = 1 or
	          INDEX(LINE, D_STRING("null;"), 1) >= 1) and
		  (UNIT = S or UNIT = G) then 
		LINE := D_STRING("");
	      end if;
	      if LENGTH(LINE) > 0 then			-- put it out --
		put_line(TMP_FILE, STR(LINE));
	      end if;
	    end loop;

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

	    close(HEADER);
	  end if;					-- "no format" block --
	  close(TMP_FILE);
	end if;						-- "Quit" block --
      exception
	when name_error | use_error => close(TMP_FILE); raise;
      end;
    end;
    end if;						-- Ada unit block --

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- --		Don't do anything if Quit, otherwise spawn EDT		-- --

    if UNIT /= Q then				-- don't do anything if QUIT --
      LINE := D_STRING("EDIT/EDT/COM=" & DIR & "EDTINI.EDT ");
      LINE := LINE & FILENAME;
      put_line("                     ... Please be patient ...");
      SPAWN_DCL(STATUS, STR(LINE),"","",0,"", PROCESS_ID, COMPLETION_STATUS);
    end if;

end CREATE_SOURCE;