/*:===============================================================================*/

/*:		Weave*/

/*:	Weave is a program for reorganizing and duplicating text  within  files.*/
/*:	It  was inspired by WEB, a Pascal-based language designed by Knuth.  The*/
/*:	WEB references I know of are:  "The WEB system of structured  documenta-*/
/*:	tion,"  Stanford Computer Science Report 980 (Stanford, California, Sep-*/
/*:	tember 1983); and "Literate Programming," The Computer Journal 27 (1984)*/
/*:	97-111.  Both references are by Knuth.*/
/*:*/
/*:		Greg Janee*/
/*:		General Research Corporation*/
/*:		P.O. Box 6770*/
/*:		Santa Barbara, CA 93160-6770*/
/*:*/
/*:	Weave  reads in the lines of specified files, reorganizes and duplicates*/
/*:	the lines as directed by commands embedded within the files, and  writes*/
/*:	the  resulting  text to an output file.  The format of the WEAVE command*/
/*:	is*/
/*:*/
/*:		WEAVE <file> [+ <file> [+ <file> ... ]]*/
/*:*/
/*:	where  <file> is the name of a file to be read.  The default filename is*/
/*:	".WEB".  The files are read in the order they are specified.   Only  the*/
/*:	first filename is used in determining the name of the output file.*/
/*:*/
/*:	Weave uses C's Standard I/O Package to read the input files,  and  hence*/
/*:	lines  generally  correspond  to  VMS records with two exceptions:  line*/
/*:	feed characters are interpreted as end-of-record markers and null  char-*/
/*:	acters  truncate  records.   A  line  is either a text line or a command*/
/*:	line.  A command line is any line whose first non-white-space characters*/
/*:	are "{:" or ":}"; all other lines are text lines.*/
/*:*/
/*:	Weave organizes text lines into sections of text.  There is  one  prede-*/
/*:	fined  section,  the  main section; all other sections are user-defined.*/
/*:	Each section has a name, which is insensitive to white space  and  case.*/
/*:	A  section  name  may not contain the string ":}".  The main section has*/
/*:	the empty name "".*/
/*:*/
/*:	At  any  given  time  there is a current section, and text lines read by*/
/*:	Weave are appended to this section.  When Weave begins reading an  input*/
/*:	file,  the  main  section is the current section.  A command line of the*/
/*:	form*/
/*:*/
/*:		{: <section-name>*/
/*:*/
/*:	changes  the  current section to the section named <section-name>.  Con-*/
/*:	versely, a command line of the form*/
/*:*/
/*:		:}*/
/*:*/
/*:	reverts the current section to what it was before the last "{: <section-*/
/*:	name>" command was encountered.  When end-of-file is reached on an input*/
/*:	file,  enough  (missing)  ":}" command lines are supplied until the main*/
/*:	section is again the current section.*/
/*:*/
/*:	A command line of the form*/
/*:*/
/*:		{: <section-name> :}*/
/*:*/
/*:	directs Weave to include the ultimate  contents  of  the  section  named*/
/*:	<section-name>  at  the current location within the current section.  To*/
/*:	create the output file Weave outputs only one section, the main section.*/
/*:	Thus  a  user-defined  section  is outputted only if explicitly included*/
/*:	within another section that is being outputted.*/
/*:*/
/*:	Finally, a command line of the form*/
/*:*/
/*:		{: weave into <filename> :}*/
/*:*/
/*:	is  not  an  inclusion command, but directs Weave to place the output in*/
/*:	a file named <filename>.  If this command is not encountered the  output*/
/*:	filename  is  "".   The name of the first input file serves as a default*/
/*:	name for the output filename.*/

/*:	The Weave source should be run through  a  preprocessor  which  converts*/
/*:	lines  having  a  colon  in  column 1 to comment lines.  Weave should be*/
/*:	linked /NOTRACEBACK with APPLY_DEFS.FOR, COMPARE_ASCIIZ.MAR,  DSA_INTER-*/
/*:	FACE.C, MESSAGES.MSG, and version V-002 of DSA/SHAREABLE.*/

/*:===============================================================================*/

/*:===============================================================================*/

#	include climsgdef
#	include ctype
#	include descrip
#	include errno
#	include ssdef
#	include stdio
#	include stsdef

/*:-------------------------------------------------------------------------------*/

/*:	A  SECTION_OF_TEXT  structure  describes a section of text.  NAME is the*/
/*:	name of the section, stored in canonical  form.   When  a  structure  is*/
/*:	allocated,  extra  space is allocated to hold the name.  CHUNK_LIST is a*/
/*:	list of CHUNK_OF_TEXT structures which describe the contents of the sec-*/
/*:	tion.   IS_BEING_WRITTEN_OUT  is a flag used to detect recursive section*/
/*:	inclusions.  IS_DEFINED is clear if the section has been referenced only*/
/*:	by one or more inclusion commands.*/

	typedef struct section_of_text stext;
	struct section_of_text {
		int	chunk_list;
		int	is_being_written_out: 1;
		int	is_defined: 1;
		int	_unused_: 30;
		char	name[1];
	};

/*:	A  CHUNK_OF_TEXT  structure  describes either an actual chunk of text (a*/
/*:	sequence of zero or more text lines) or an inclusion chunk (a  reference*/
/*:	to  another section of text).  IS_INCLUSION indicates the variant of the*/
/*:	chunk.  In an actual chunk, LINE_LIST is a list of text lines comprising*/
/*:	the chunk.  In an inclusion chunk, INCLUSION_SECTION is a DSA pointer to*/
/*:	the SECTION_OF_TEXT structure of the section to be included, and LINE_NO*/
/*:	and  FILENAME  describe the location of the inclusion command for error-*/
/*:	signaling purposes.  When an inclusion chunk is allocated,  extra  space*/
/*:	is allocated to hold the filename.*/

	typedef struct chunk_of_text ctext;
	struct chunk_of_text {
		int	is_inclusion: 1;
		int	_unused_: 31;
		int	line_list;
		int	inclusion_section;
		int	line_no;
		char	filename[1];
	};

	typedef struct dsc$descriptor_s strdsc;

/*:-------------------------------------------------------------------------------*/

#	define component(x,y) ( (char *) &((x *) dsa$template())->y )
#	define C_asciiz 9
#	define C_backwards 0
#	define C_displayable 2
#	define C_equal 0
#	define C_mfs 255		/* maximum filename size */
#	define C_mll 32767		/* maximum line length */
#	define C_usable 0

/*:	Error codes...*/

	globalvalue EC_chaign;
	globalvalue EC_comlin;
	globalvalue EC_disofo;
	globalvalue EC_erratl;
	globalvalue EC_errclo;
	globalvalue EC_errcre;
	globalvalue EC_errope;
	globalvalue EC_errrea;
	globalvalue EC_errwri;
	globalvalue EC_linign;
	globalvalue EC_lintoo;
	globalvalue EC_lintru;
	globalvalue EC_nooutf;
	globalvalue EC_recsec;
	globalvalue EC_secisn;
	globalvalue EC_secnot;
	globalvalue EC_unrcha;
	globalvalue EC_waratl;
	globalvalue EC_warrea;

/*:-------------------------------------------------------------------------------*/

/*:	Global  variables.   G_SECTION_LIST  is a list of SECTION_OF_TEXT struc-*/
/*:	tures; all such structures are on this list.  There is one structure for*/
/*:	each section of text.*/

	int	G_section_list;

/*:	A CHUNK_OF_TEXT structure is on exactly one section's  chunk  list,  and*/
/*:	similarly  a text line is on exactly one chunk's line list.  A section's*/
/*:	chunk list is never empty, and the last CHUNK_OF_TEXT structure  on  the*/
/*:	list is always an actual chunk.*/

/*:	G_CURRENT_SECTION and G_CURRENT_CHUNK point to, respectively,  the  SEC-*/
/*:	TION_OF_TEXT structure of the current section and the last CHUNK_OF_TEXT*/
/*:	structure on G_CURRENT_SECTION->CHUNK_LIST.*/

	stext	*G_current_section;
	ctext	*G_current_chunk;

/*:	G_SECTION_STACK  is  a  stack (implemented as a list) of SECTION_OF_TEXT*/
/*:	structures.  A structure need not be on this stack, and a structure  may*/
/*:	be on this stack multiply.  The stack is used to implement the ":}" com-*/
/*:	mand.*/

	int	G_section_stack;

/*:	G_OUTPUT_FILENAME is the name of the output file, as provided by the "{:*/
/*:	weave into <filename> :}" command.*/

	char	G_output_filename[C_mfs+1];

/*:===============================================================================*/

/*:===============================================================================*/

	int	main ( )
{
	char	filename[C_mfs+1];	$DESCRIPTOR( fn_desc, filename );
	char	first_name[C_mfs+1];	$DESCRIPTOR( q_file, "FILE" );
	int	first_time;		int	status;

	char	*apply_defaults();	char	*strcpy();
	int	cli$get_value();	char	*trim();
	void	create_database();	void	write_output_file();
	void	read_input_file();

/*:-------------------------------------------------------------------------------*/

	create_database();

	first_time = 0;
	do {

		status = cli$get_value( &q_file, &fn_desc );
		filename[C_mfs] = '\0'; trim( filename );

		apply_defaults( filename, ".WEB", C_usable );

		if ( first_time++ == 0 ) strcpy( first_name, filename );

		read_input_file( filename );

	} while ( status == CLI$_CONCAT );

	apply_defaults( G_output_filename, first_name, C_usable );
	write_output_file();

	return SS$_NORMAL;
}
/*:===============================================================================*/

/*:===============================================================================*/

	char	*apply_defaults ( filename, default_name, options )

	char	*filename;
	char	*default_name;
	int	options;
{
	strdsc	descriptor();

	strdsc	dn_desc = descriptor( default_name );
	strdsc	fn_desc = descriptor( filename );
	strdsc	output_desc;
	int	status;
	char	temp[C_mfs+1];

	int	apply_defs();
	char	*strcpy();
	char	*trim();

/*:-------------------------------------------------------------------------------*/

	strcpy( temp, filename );

	output_desc = fn_desc; output_desc.dsc$w_length = C_mfs;
	status = apply_defs( &fn_desc, &dn_desc, &options, &output_desc );

	if ( status & STS$M_SUCCESS ) {
		filename[C_mfs] = '\0'; trim( filename );
	}
	else {
		strcpy( filename, temp );
	}

	return filename;
}
/*:===============================================================================*/

/*:===============================================================================*/

	char	*clean ( string )

	char	*string;
{
	char	*ptr1;
	char	*ptr2;

	char	next_char();
	int	toupper();

/*:-------------------------------------------------------------------------------*/

	ptr1 = string; while ( isspace( *ptr1 ) ) ++ptr1;
	ptr2 = string;

	while ( (*ptr2 = toupper( next_char(&ptr1) )) != '\0' ) ++ptr2;

	if ( ptr2 != string && *(--ptr2) == ' ' ) *ptr2 = '\0';
	return string;
}
/*:===============================================================================*/

/*:===============================================================================*/

	char	next_char ( ptr )

	char	**ptr;
{
/*:-------------------------------------------------------------------------------*/

	if ( isspace( **ptr ) ) {
		while ( isspace( **ptr ) ) ++(*ptr);
		return ' ';
	}
	else return *((*ptr)++);
}
/*:===============================================================================*/

/*:===============================================================================*/

	int	close_and_delete_file ( file )

	FILE	*file;
{
	char	filename[C_mfs+1];

	int	delete();
	int	fclose();
	char	*fgetname();

/*:-------------------------------------------------------------------------------*/

	fgetname( file, filename );
	return ( fclose( file ) == 0 && delete( filename ) == 0 );
}
/*:===============================================================================*/

/*:===============================================================================*/

	void	create_database ( )
{
	stext	*create_section();	void	dsa$initialize();
	int	dsa$create_dbsa();	void	dsa$switch_db();
	void	dsa$define_type();	char	*last_dataset();

	globalvalue compare_asciiz_a;
	globalvalue compare_asciiz_d;

/*:-------------------------------------------------------------------------------*/

	dsa$switch_db( dsa$create_dbsa( 0 ) );
	dsa$initialize( 0, 0, 0 );

	dsa$define_type( &C_asciiz, &1, compare_asciiz_a, compare_asciiz_d, 0 );

	G_section_list = 0;
	G_current_section = create_section( "" );
	G_current_section->is_defined = TRUE;
	G_current_chunk = (ctext *)
		last_dataset( G_current_section->chunk_list );

	G_section_stack = 0;
	G_output_filename[0] = '\0';
}
/*:===============================================================================*/

/*:===============================================================================*/

	stext	*create_section ( name )

	char	*name;
{
	ctext	*chunk;			stext	*section;

	char	*dsa$create();		char	*strcpy();
	void	dsa$putbot();		int	strlen();

/*:-------------------------------------------------------------------------------*/

	section = (stext *) dsa$create( sizeof(stext) + strlen(name) );
	strcpy( section->name, name );
	dsa$putbot( &G_section_list, (char *) section );

	chunk = (ctext *) dsa$create( sizeof(ctext) );
	dsa$putbot( &section->chunk_list, (char *) chunk );

	return section;
}
/*:===============================================================================*/

/*:===============================================================================*/

	strdsc	descriptor ( string )

	char	*string;
{
	strdsc	d;

	int	strlen();

/*:-------------------------------------------------------------------------------*/

	d.dsc$w_length  = strlen( string );
	d.dsc$b_dtype   = DSC$K_DTYPE_T;
	d.dsc$b_class   = DSC$K_CLASS_S;
	d.dsc$a_pointer = string;

	return d;
}
/*:===============================================================================*/

/*:===============================================================================*/

	char	*index ( string, substring )

	char	*string;
	char	*substring;
{
	strdsc	descriptor();

	strdsc	desc_1 = descriptor( string );
	strdsc	desc_2 = descriptor( substring );
	int	i;

	int	str$position();

/*:-------------------------------------------------------------------------------*/

	i = str$position( &desc_1, &desc_2 );
	return ( i == 0 ? NULL : &string[i-1] );
}
/*:===============================================================================*/

/*:===============================================================================*/

	int	is_white_space ( string )

	char	*string;
{
	char	*ptr;

/*:-------------------------------------------------------------------------------*/

	ptr = string; while ( isspace( *ptr ) ) ++ptr;
	return ( *ptr == '\0' );
}
/*:===============================================================================*/

/*:===============================================================================*/

	char	*last_dataset ( list )

	int	list;
{
	int	temp;

	char	*dsa$prev();

/*:-------------------------------------------------------------------------------*/

	return dsa$prev( (temp = list, &temp) );
}
/*:===============================================================================*/

/*:===============================================================================*/

	char	*pop ( stack )

	int	*stack;
{
	char	*dataset;
	int	temp;

	char	*dsa$prev();
	void	dsa$remove();

/*:-------------------------------------------------------------------------------*/

	dataset = dsa$prev( (temp = *stack, &temp) );
	dsa$remove( stack, temp );

	return dataset;
}
/*:===============================================================================*/

/*:===============================================================================*/

	void	process_close_bracket ( line, fn_desc, line_no )

	char	*line;			int	line_no;
	strdsc	*fn_desc;
{
	int	is_white_space();	void	lib$signal();
	char	*last_dataset();	char	*pop();

/*:-------------------------------------------------------------------------------*/

	if ( !is_white_space( line ) ) lib$signal( EC_waratl, 2, line_no,
		fn_desc, EC_unrcha, 0, EC_chaign );

	if ( G_section_stack == 0 )
		lib$signal( EC_waratl, 2, line_no, fn_desc, EC_comlin, 0,
			EC_linign );
	else {
		G_current_section = (stext *) pop( &G_section_stack );
		G_current_chunk = (ctext *)
			last_dataset( G_current_section->chunk_list );
	}
}
/*:===============================================================================*/

/*:===============================================================================*/

	void	process_line ( line, fn_desc, line_no )

	char	*line;
	strdsc	*fn_desc;
	int	line_no;
{
	char	*ptr;

	void	process_close_bracket();
	void	process_open_bracket();
	void	process_text_line();

/*:-------------------------------------------------------------------------------*/

	ptr = line; while ( isspace( *ptr ) ) ++ptr;

	if      ( *((short *) ptr) == '{:' )
		process_open_bracket(  ptr+2, fn_desc, line_no );
	else if ( *((short *) ptr) == ':}' )
		process_close_bracket( ptr+2, fn_desc, line_no );
	else {
		process_text_line( line );
	}
}
/*:===============================================================================*/

/*:===============================================================================*/

	void	process_open_bracket ( line, fn_desc, line_no )

	char	*line;			int	line_no;
	strdsc	*fn_desc;
{
	char	*ptr;

	char	*clean();		void	process_section_definition();
	char	*index();		void	process_section_inclusion();
	int	is_white_space();	int	strncmp();
	void	lib$signal();		char	*strncpy();

/*:-------------------------------------------------------------------------------*/

	if ( (ptr = index( line, ":}" )) != NULL ) {

		if ( !is_white_space( ptr+2 ) ) lib$signal( EC_waratl, 2,
			line_no, fn_desc, EC_unrcha, 0, EC_chaign );

		*ptr = '\0'; clean( line );

		if ( strncmp( line, "WEAVE INTO ", 11 ) == 0 ) {
			strncpy( G_output_filename, &line[11], C_mfs );
			G_output_filename[C_mfs] = '\0';
		}
		else {
			process_section_inclusion( line, fn_desc, line_no );
		}

	}
	else {
		process_section_definition( clean( line ) );
	}
}
/*:===============================================================================*/

/*:===============================================================================*/

	void	process_section_definition ( section_name )

	char	*section_name;
{
	stext	*section;

	stext	*create_section();	char	*last_dataset();
	char	*dsa$template();	void	push();
	char	*dsa$zobtan1();

/*:-------------------------------------------------------------------------------*/

	section = (stext *) dsa$zobtan1( G_section_list, C_backwards,
		component( stext, name ), C_equal, section_name, C_asciiz );

	if ( section == NULL ) section = create_section( section_name );

	section->is_defined = TRUE;

	push( &G_section_stack, (char *) G_current_section );

	G_current_section = section;
	G_current_chunk = (ctext *)
		last_dataset( G_current_section->chunk_list );
}
/*:===============================================================================*/

/*:===============================================================================*/

	void	process_section_inclusion ( section_name, fn_desc, line_no )

	char	*section_name;		int	line_no;
	strdsc	*fn_desc;
{
	ctext	*chunk;			stext	*section;

	stext	*create_section();	char	*dsa$template();
	char	*dsa$create();		char	*dsa$zobtan1();
	int	dsa$dspwrd();		char	*strcpy();
	void	dsa$putbot();

/*:-------------------------------------------------------------------------------*/

	section = (stext *) dsa$zobtan1( G_section_list, C_backwards,
		component( stext, name ), C_equal, section_name, C_asciiz );

	if ( section == NULL ) section = create_section( section_name );

	chunk = (ctext *) dsa$create( sizeof(ctext) + fn_desc->dsc$w_length );

	chunk->is_inclusion = TRUE;
	chunk->inclusion_section = dsa$dspwrd( (char *) section );
	chunk->line_no = line_no;
	strcpy( chunk->filename, fn_desc->dsc$a_pointer );

	dsa$putbot( &G_current_section->chunk_list, (char *) chunk );

	chunk = (ctext *) dsa$create( sizeof(ctext) );
	dsa$putbot( &G_current_section->chunk_list, (char *) chunk );

	G_current_chunk = chunk;
}
/*:===============================================================================*/

/*:===============================================================================*/

	void	process_text_line ( line )

	char	*line;
{
	char	*line_holder;

	char	*dsa$create();		char	*strcpy();
	void	dsa$putbot();		int	strlen();

/*:-------------------------------------------------------------------------------*/

	line_holder = dsa$create( strlen(line)+1 );
	strcpy( line_holder, line );

	dsa$putbot( &G_current_chunk->line_list, line_holder );
}
/*:===============================================================================*/

/*:===============================================================================*/

	void	push ( stack, dataset )

	int	*stack;
	char	*dataset;
{
	void	dsa$putbot();

/*:-------------------------------------------------------------------------------*/

	dsa$putbot( stack, dataset );
}
/*:===============================================================================*/

/*:===============================================================================*/

	void	read_input_file ( filename )

	char	*filename;
{
	strdsc	fn_desc;		int	line_no;
	FILE	*input_file;		char	*ptr;
	char	line[C_mll+2];

	char	*apply_defaults();	FILE	*fopen();
	strdsc	descriptor();		void	lib$signal();
	int	fclose();		void	lib$stop();
	char	*fgetname();		void	process_line();
	char	*fgets();		char	*strchr();

/*:-------------------------------------------------------------------------------*/

	if ( (input_file = fopen( filename, "r" )) == NULL ) {
		fn_desc = descriptor( apply_defaults( filename, "",
			C_displayable ) );
		lib$stop( EC_errope, 1, &fn_desc, vaxc$errno, 0, EC_nooutf );
	}

	fn_desc = descriptor( fgetname( input_file, filename ) );
	line_no = 1;

	while ( fgets( line, sizeof(line), input_file ) != NULL ) {

		if ( (ptr = strchr( line, '\n' )) == NULL ) {
			lib$signal( EC_warrea, 2, line_no, &fn_desc, EC_lintoo,
				0, EC_lintru );
		}
		else *ptr = '\0';

		process_line( line, &fn_desc, line_no );

		++line_no;

	}

	if ( !feof( input_file ) ) lib$stop( EC_errrea, 2, line_no, &fn_desc,
		vaxc$errno, 0, EC_nooutf );

	while ( G_section_stack != 0 ) process_line( ":}", NULL, 0 );

	if ( fclose( input_file ) != 0 ) lib$stop( EC_errclo, 1, &fn_desc,
		vaxc$errno, 0, EC_nooutf );
}
/*:===============================================================================*/

/*:===============================================================================*/

	char	*trim ( string )

	char	*string;
{
	int	i;

	int	strlen();

/*:-------------------------------------------------------------------------------*/

	for ( i = strlen(string)-1; i >= 0; --i ) {
		if ( !isspace( string[i] ) ) {
			string[i+1] = '\0'; break;
		}
	}

	return string;
}
/*:===============================================================================*/

/*:===============================================================================*/

	void	write_chunk ( chunk, output_file, fn_desc )

	ctext	*chunk;			strdsc	*fn_desc;
	FILE	*output_file;
{
	int	ctx;			int	temp;
	char	*line;

	int	close_and_delete_file();
	char	*dsa$next();		void	lib$stop();
	int	fputc();		void	write_inclusion_chunk();
	int	fputs();

/*:-------------------------------------------------------------------------------*/

	if ( chunk->is_inclusion )
		write_inclusion_chunk( chunk, output_file, fn_desc );
	else {

		ctx = chunk->line_list;
		while ( (line = dsa$next( &ctx )) != NULL ) {

			fputs( line, output_file );
			fputc( '\n', output_file );

			if ( ferror( output_file ) ) {
				temp = vaxc$errno;
				lib$stop( EC_errwri, 1, fn_desc, temp, 0,
				( close_and_delete_file( output_file ) ?
				EC_nooutf : EC_disofo ) );
			}

		}

	}
}
/*:===============================================================================*/

/*:===============================================================================*/

	void	write_inclusion_chunk ( chunk, output_file, ofn_desc )

	ctext	*chunk;			strdsc	*ofn_desc;
	FILE	*output_file;
{
	strdsc	ifn_desc;		strdsc	sn_desc;
	stext	*section;

	int	close_and_delete_file();
	strdsc	descriptor();		void	lib$stop();
	char	*dsa$indwrl();		void	write_section();
	void	lib$signal();

/*:-------------------------------------------------------------------------------*/

	section = (stext *) dsa$indwrl( chunk->inclusion_section );

	if ( section->is_being_written_out ) {
		ifn_desc = descriptor( chunk->filename );
		lib$stop( EC_erratl, 2, chunk->line_no, &ifn_desc, EC_recsec, 0,
			( close_and_delete_file( output_file ) ? EC_nooutf :
			EC_disofo ) );
	}

	if ( !section->is_defined ) {
		ifn_desc = descriptor( chunk->filename );
		sn_desc = descriptor( section->name );
		lib$signal( EC_waratl, 2, chunk->line_no, &ifn_desc, EC_secisn,
			1, &sn_desc, EC_secnot );
	}

	write_section( section, output_file, ofn_desc );
}
/*:===============================================================================*/

/*:===============================================================================*/

	void	write_output_file ( )
{
	strdsc	fn_desc;		FILE	*output_file;

	char	*apply_defaults();	FILE	*fopen();
	strdsc	descriptor();		void	lib$stop();
	int	fclose();		void	write_section();
	char	*fgetname();

/*:-------------------------------------------------------------------------------*/

	output_file = fopen( G_output_filename, "w", "fop=mxv", "rfm=var",
		"rat=cr", "mrs=32767" );

	if ( output_file == NULL ) {
		fn_desc = descriptor( apply_defaults( G_output_filename, "",
			C_displayable ) );
		lib$stop( EC_errcre, 1, &fn_desc, vaxc$errno, 0, EC_nooutf );
	}

	fn_desc = descriptor( fgetname( output_file, G_output_filename ) );

	write_section( G_current_section, output_file, &fn_desc );

	if ( fclose( output_file ) != 0 ) lib$stop( EC_errclo, 1, &fn_desc,
		vaxc$errno, 0, EC_disofo );
}
/*:===============================================================================*/

/*:===============================================================================*/

	void	write_section ( section, output_file, fn_desc )

	stext	*section;		strdsc	*fn_desc;
	FILE	*output_file;
{
	ctext	*chunk;			int	ctx;

	char	*dsa$next();		void	write_chunk();

/*:-------------------------------------------------------------------------------*/

	section->is_being_written_out = TRUE;

	ctx = section->chunk_list;
	while ( (chunk = (ctext *) dsa$next( &ctx )) != NULL ) {
		write_chunk( chunk, output_file, fn_desc );
	}

	section->is_being_written_out = FALSE;
}
/*:===============================================================================*/
