@z --- style.web ---

FWEB version 1.60-beta (January 1, 1997)

Based on version 0.5 of S. Levy's CWEB [copyright (C) 1987 Princeton University]

@x-----------------------------------------------------------------------------


\Title{STYLE.WEB} % Reading the style file for FWEAVE and FTANGLE.

@c
@* INTRODUCTION.
Here we read a style file. Style files are used to customize the output of
\FWEAVE---for example, to adjust the appearance of the index.  The default
style file is called \.{fweb.sty} in the directory set by the environment
variable \.{FWEB\_STYLE\_DIR}, or in the directory of the \WEB\ source.
The name can be changed with the \.{-z}~option: ``\.{-znew\_name}''.

Unlike the rest of the \FWEB\ processors, the style file does not
automatically convert its input into |ASCII|.  That's because most of its
fields are never manipulated internally, but are just written to the output
file.  This may or may not have been a good design decision.

Associations between vocabulary words and internal \FWEB\ fields are made
in \.{map.web}.

\It{We should discuss the detailed scheme here.}

@m _STYLE_
@d _STYLE_h

@A 
@<Include files@>@;
@<Typedef declarations@>@;
@<Global variables@>@;

@I typedefs.hweb

@
@<Include...@>=
#include "map.h"

@ 

@d CMNT_CHAR '%' // The comment character in the style file.

@I mem.hweb

@ We need a few miscellaneous declarations.
@<Glob...@>=

outer_char HUGE *sprm_buf,HUGE *sprm_ptr,HUGE *sprm_end; // For \.{-p} option.
outer_char HUGE *sprm_ptr0; // Marks beginning of command-line \.{-p} options.

boolean from_sprm;
static BUF_SIZE sbuf_len; // Length of line buffer.
static outer_char HUGE *stemp, HUGE *stemp_end,HUGE *tloc; /* Temporary
	hold for the argument, and position in it. */ 
static outer_char cur_char; /* Current character after possible escape
				translation. */
extern ASCII xord[];
extern outer_char xchr[];

@* PROCESSING ARGUMENTS. We begin with a routine that converts the
character representation of an escaped character to the proper byte.  Note
that the escapes \.{'\\\\'}, \.{'\\''}, \.{'\\"'}, and~\.{'\\?'} can be
handled as part of the |default|.  This routine also handles octal and hex
escapes of the form~\.{\\123} or~\.{\\xFF}.  The function takes the address
of a pointer to the first character; when it exits, that pointer has been
updated to the next non-translated character.  We provide separate
functions for escaping |outer_char|s and |ASCII|s.

@d isodigit(c) (isdigit(c) && (c)!='8' && (c)!='9')
	// An |outer_char| octal digit?

@a
outer_char @\
esc_char FCN((ppc))
	CONST outer_char HUGE * HUGE *ppc C1("")@;
{
int k;
unsigned n;
CONST outer_char HUGE *pc = *ppc; // Pointer to first character after~'\.\\'.

if(isodigit(*pc))
	@<Process octal constant@>@;
else if(*pc == 'x' && isxdigit(*(pc+1)))
	@<Process hex constant@>@;
else 
	{ /* Handle ordinary escaped character. */
	switch(*pc)
		{
   	   case 'a': n = '\007'; @+ break;
	   case 'b': n = '\b'; @+ break;
	   case 'f': n = '\f'; @+ break;
	   case 'n': n = '\n'; @+ break;
	   case 'r': n = '\r'; @+ break;
	   case 't': n = '\t'; @+ break;
	   case 'v': n = '\v'; @+ break;
	   default: 
		n = (unsigned)(*pc); // Unknowns, like '\.{\\m}' $\to$~'\.m'.
		break;
		}
	pc++;
	}

*ppc = pc;
return (outer_char)n;
}

@ Octal constants have the form \.{\\123}.
@<Process octal constant@>=
{
n = ctoi(*pc++);
for(k=0; k<2; k++)
	{
	if(!isodigit(*pc)) break;
	n = 8*n + ctoi(*pc++);
	}
}

@ Hex constants have the form \.{\\xFF}.
@<Process hex constant@>=
{
pc++; // Position after \.{'x'}.
n = ctoi(*pc++);
if(isxdigit(*pc)) n = 16*n + ctoi(*pc++);
}

@ The corresponding function for |ASCII|.

@a
ASCII @\
esc_achar FCN((ppc))
	CONST ASCII HUGE * HUGE *ppc C1("")@;
{
int k;
unsigned n;
CONST ASCII HUGE *pc = *ppc; // Pointer to first character after~'\.\\'.

if(isOdigit(*pc))
	@<Process Octal constant@>@;
else if(*pc == @'x' && isXdigit(*(pc+1)))
	@<Process Hex constant@>@;
else 
	{
	switch(*pc)
		{
   	   case @'a': n = @'\007'; @+ break;
	   case @'b': n = @'\b'; @+ break;
	   case @'f': n = @'\f'; @+ break;
	   case @'n': n = @'\n'; @+ break;
	   case @'r': n = @'\r'; @+ break;
	   case @'t': n = @'\t'; @+ break;
	   case @'v': n = @'\v'; @+ break;
	   default: n = *pc; @+ break; // Unknowns, like '\.{\\m}' $\to$~'\.m'.
		}

#if(DEBUG_XCHR)
	n = XCHR(n);
#endif
	pc++;
	}

*ppc = pc; // Advance the pointer to point beyond the end of the constant.

#if(DEBUG_XCHR)
	n = xord[n];
#endif

return (ASCII)n; // Return the value.
}

@ Octal constants have the form \.{\\123}.  The following is for |ASCII|.
@<Process Octal constant@>=
{
n = Ctoi(*pc++);
for(k=0; k<2; k++)
	{
	if(!isOdigit(*pc)) break;
	n = 8*n + Ctoi(*pc++);
	}
}

@ Hex constants have the form \.{\\xFF}.  The following is for |ASCII|.
@<Process Hex constant@>=
{
pc++; // Position after \.{'x'}.
n = Ctoi(*pc++);
if(isXdigit(*pc)) n = 16*n + Ctoi(*pc++);
}

@ Translate a hex |outer_char| into integer.

@m XC(cin,cout) case cin: return 0x##cout@;

@d Ctoi(c) ctoi(XCHR(c)) // For |ASCII|.

@a
int @\
ctoi FCN((c))
	outer_char c C1("")@;
{
switch(c)
	{
   XC('0',0); XC('1',1); XC('2',2); XC('3',3); XC('4',4); XC('5',5);
   XC('6',6); XC('7',7); XC('8',8); XC('9',9); 
   XC('a',a); @+ XC('A',A);
   XC('b',b); @+ XC('B',B);
   XC('c',c); @+ XC('C',C);
   XC('d',d); @+ XC('D',D);
   XC('e',e); @+ XC('E',E);
   XC('f',f); @+ XC('F',F);
   default: return 0;
	}
}

@ Search for a keyword.  Returns address of the relevant |S_MAP| entry.
@a
S_MAP @\
HUGE *find_sty FCN((m,keyword))
	S_MAP HUGE *m C0("Array of map variables")@;
	CONST outer_char HUGE *keyword C1("Search for this keyword")@;
{
for(; *(m->keyword); m++)
	if(STRCMP(keyword,m->keyword) == 0) return m;

return NULL;
}

@ Read one line from style file. 
@a
boolean @\
sty_line(VOID)
{
typedef enum {FROM_INI, FROM_LOCAL, FROM_CMD_LINE} STYLE_MODE;

static STYLE_MODE mode = FROM_INI;

from_sprm = BOOLEAN(mode == FROM_INI || mode == FROM_CMD_LINE);

switch(mode)
	{
   case FROM_INI:
	if(!sty0_line(sprm_ptr0))
		mode++;
	else
		return YES;

   case FROM_LOCAL:
	if(!sty0_line(NULL))
		mode++;
	else
		return YES;

   case FROM_CMD_LINE:
	return sty0_line(sprm_end);
	}

return YES; // Dummy.
}

boolean @\
sty0_line FCN((last_sprm))
	outer_char HUGE *last_sprm C1("")@;
{
int c; /* Single character read from style file. |int| rather than |char|
		because that's what |getc| returns. */

sloc = slimit = sbuf; // Position to beginning of line.

if(last_sprm)
	{ /* Read from the \.{-p} buffer. */
	if(sprm_ptr >= last_sprm) 
		{ /* Nothing more in the \.{-p} buffer. */
		s_line = 0;
		return NO;
		}
	else
		{ /* Copy line from \.{-p} buffer. */
		int n;
		outer_char HUGE *p;

		if((p=(outer_char HUGE *)STRCHR(sprm_ptr,'\n')) == NULL)
			{
			err_print(S,"Trouble in sty_line");
			return NO;
			}
		else n = PTR_DIFF(int, p, sprm_ptr);
	
		STRNCPY(sloc,sprm_ptr,n);
		sprm_ptr += n + 1;
		slimit += n;
		s_line++;
		}
	}
else
	{ /* Read from the local style file. */
	if(!sty_file) 
		@<Attempt to open style file@>@;

	@<Move characters from style file; |return NO| if end-of-file@>@;
	}

return YES;
}

@
@<Attempt to open...@>=
{
outer_char full_sty_name[MAX_FILE_NAME_LENGTH];

/* If there's no style file, do nothing. */
if(!*sty_file_name) 
	return NO;

if(warn_if_absent) 
	{
	STRCPY(full_sty_name, sty_file_name);
	add_prefix(full_sty_name);
	}
else 
	mk_fname(full_sty_name, MAX_FILE_NAME_LENGTH,
				OC(ENV_FWEB_STY), NO,sty_file_name);

if((sty_file = fopen((char *)full_sty_name,"r")) == NULL)
	{
	if(warn_if_absent) 
		{
		err_print(C,"Can't open style file %s",
			full_sty_name);
		}
	return NO;
	}

reading(full_sty_name,YES);
}

@
@<Move characters from style...@>=
{
if(feof(sty_file)) 
	return NO;

s_line++;

while((c = getc(sty_file)) != EOF && c != '\n')
	{
	if(slimit == sbuf_end)
		{
		err_print(S,"Input line too long; max is %lu characters",
			sbuf_len);
		ungetc(c,sty_file);
		break;
		}

	*slimit++ = (outer_char)c; // Put character into buffer.
	}
}

@ Extract the next argument from the style file.  Keywords begin with an
alphabetic character or an underscore.
@a
STY_TYPE @\
next_sty(VOID)
{
outer_char c; /* Single character from the buffer. */

WHILE()
	{
/* If we get to the end of the line or recognize a comment, read the next
line. */
	if(sloc == slimit || (c= *sloc++) == CMNT_CHAR) 
		{
		if(!sty_line()) 
			return S_DONE; // Get more.

		continue;
		}

	if(isalpha(c) || c=='_') 
		@<Style keyword@>@;
	else if(isdigit(c) || c=='-' || c=='+') 
		@<Style number@>@;
	else if(c == '"') 
		@<Style string@>@;
	else if(c == '\'') 
		@<Style character@>@;
	else if(c==' ' || c=='\t' || c=='=') 
		continue;
	else 
		{
		err_print(S,"Invalid style-file field; \
skipping remainder of file");
		longjmp(top_of_style,1);
		}
	}

DUMMY_RETURN(S_DONE);
}

@ Read a keyword into the buffer |stemp|.  Keywords consists of
alphanumeric characters, underscores, or periods.  However, the periods are
made equivalent to underscore so one can things such as ``\.{color.red}''
instead of ``\.{color\_red}''.

@m S_RETURN(t) *tloc = '\0'; return S_##t@; /* Terminate |stemp|, and
					return the appropriate type. */

@<Style keyword@>=
{
sloc--;
tloc = stemp;

while(sloc < slimit 
	   && (isalpha(*sloc) || isdigit(*sloc) || *sloc=='_' || *sloc=='.'))
	{
	cur_char = *sloc++;
	@<Copy and translate style character@>@; 
	}

S_RETURN(KEYWORD);
}

@ Move one character into |stemp|.
@<Copy and translate style char...@>=
{
if(tloc < stemp_end) 
	*tloc++ = (outer_char)CHOICE(cur_char=='.', '_', cur_char);
else
	{
	err_print(S, "Style-file buffer overflow.  \
Try using `-ysb' to increase the size");
	break;
	}
}

@
@<Copy style character@>=
{
if(tloc < stemp_end) 
	*tloc++ = cur_char;
else
	{
	err_print(S, "Style-file buffer overflow.  \
Try using `-ysb' to increase the size");
	break;
	}
}

@ Process a string argument (bracketed by double quotes).  We must allow
for escapes, such as ``\.{\\123}''.
@<Style string@>=
{
tloc = stemp; /* Start of buffer. */

while(*sloc != '"')
	{
	if(sloc == slimit)
		{
		err_print(S, "Missing double quote inserted at end of string.  \
Did you mean to continue the line with '\\'?  \
(No white space is allowed after the '\\'.)");
		S_RETURN(STRING);
		}

	if(*sloc == '\\')
		if(++sloc == slimit)
			{
			sty_line(); // String is continued.
			continue;
			}
		else 
			cur_char = esc_char(&sloc);
	else 
		cur_char = *sloc++;

	@<Copy sty...@>@;
	}

sloc++; // Skip over terminating quote.

S_RETURN(STRING);
}

@ Process a numerical argument.
@<Style number@>=
{
sloc--;
tloc = stemp;

if(*sloc=='+' || *sloc=='-') 
	{
	cur_char = *sloc++; 
	@<Copy sty...@>@;
	}

while(sloc < slimit && isdigit(*sloc)) 
	{
	cur_char = *sloc++; 
	@<Copy sty...@>@;
	}

if(sloc == slimit)
	S_RETURN(INT);

/* We allow the possibility of long integers. */
if(*sloc == 'l' || *sloc == 'L')
	{
	sloc++; // Skip over '\.L'.
	S_RETURN(LONG);
	}

S_RETURN(INT);
}

@ Process a character argument such as~'\.c' or~'\.{\\n}'.
@<Style character@>=
{
tloc = stemp;

/* If the character is escaped, turn the next character into the actual
byte. */
if(*sloc == '\\') 
	{
	sloc++; 
	cur_char = esc_char(&sloc);
	}
else 
	cur_char = *sloc++;

@<Copy sty...@>@;

if(*sloc != '\'')
	err_print(S, "Missing single quote inserted");
else
	sloc++; // Skip over closing quote.

S_RETURN(CHAR);
}

@* READING the STYLE FILE.
The style file is both opened and closed in this module.

@f jmp_buf int

@<Glob...@>=

static CONST outer_char *sty_file_name;
static boolean warn_if_absent;
static FILE *sty_file;
static S_MAP HUGE *map_array = fweb_map; /* Points to the common map
	array for both \FWEAVE\ and \FTANGLE. */
jmp_buf top_of_style; // Environment for the |setjmp|--|longjmp|.

@ It's read line by line into a buffer. The length of that buffer can be
set by dynamic memory allocation with option~\.{-ysb}.

@d ENV_FWEB_STY "FWEB_STYLE_DIR" /* Environment variable that defines
		directory of style file.  */

@a
SRTN @\
read_sty FCN((sty_file_name0,warn_if_absent0))
	CONST outer_char sty_file_name0[] C0("")@;
	boolean warn_if_absent0 C1("")@;
{
sty_file_name = sty_file_name0;
warn_if_absent = warn_if_absent0;

@<Modify defaults based on option settings@>@;

@<Allocate buffers for the style file@>@;

if(setjmp(top_of_style) != 0) goto done_sty;

/* Read the first line of style file. If the file's empty, do nothing. */
if(!sty_line()) goto done_sty;

/* Parse the file. */
WHILE()
	switch(next_sty())
		{
		case S_CMNT: break;

		case S_KEYWORD:
			@<Process style keyword@>@;
			break;

		default:
			err_print(S,"Was expecting keyword or comment here; \
skipping remainder of file"); // Falls through to |case S_DONE@:|.

		case S_DONE:
		 done_sty:
			if(sty_file) fclose(sty_file);
			if(sprm_buf) FREE(sprm_buf);
			FREE_MEM(stemp,"stemp",sbuf_len,outer_char);
			FREE_MEM(sbuf,ABBREV(sbuf_len),sbuf_len,outer_char);
			return;
		}
}

@ In a few cases, the proper defaults depend on command-line options; for
example, which processor will be used to process \FWEAVE's output.
@<Modify defaults...@>=
{
IN_COMMON outer_char HUGE *style_args;

if(TeX_processor == LaTeX_p)
	{
	W_META HUGE *m = &w_style.misc.meta;
	INDEX HUGE *i = &w_style.indx;

	pfrmt->id = pfrmt->id_outer = pfrmt->id_inner = OC("\\>");
	pfrmt->ID = pfrmt->ID_OUTER = pfrmt->ID_INNER = OC("\\WUC");
	pfrmt->RESERVED = OC("\\WRS");

	m->TeX.begin = OC("\\begin{verbatim}");
	m->TeX.end = OC("\\end{verbatim}");	
	m->code.begin = OC("\\WBM ");
	m->code.end = OC("\\WEM ");

	i->encap_prefix = OC("\\M");
	i->encap_infix = OC("{");
	i->encap_suffix = OC("}");
	}

if(prn_style_defaults) 
	see_style(style_args, YES);
}

@ We temporarily allocate buffers for working with the style file.
@<Allocate buffers...@>=
{
ALLOC(outer_char,sbuf,ABBREV(sbuf_len),sbuf_len,0);
sbuf_end = sbuf + sbuf_len;

stemp = GET_MEM("stemp",sbuf_len,outer_char);
stemp_end = stemp + sbuf_len;

/* Reset the \.{-p} buffer. */
sprm_end = sprm_ptr; // Actual end of material in buffer.
sprm_ptr = sprm_buf; // Start at beginning.
}

@ At the very beginning, initializations must be finished.
@a
SRTN ini_style(VOID)
{
ini_colors(NO_COLOR);

@<Finish initializing mappings@>@;
}

@ We've recognized a keyword. Now deal with its arguments.  First, the
argument is copied into the appropriate field.  Then, if an initialization
routine has been defined, that routine is run on the argument.  The
argument might be checked for validity, or it might be changed into
something else.
@<Process style key...@>=
{
S_MAP HUGE *ps; // Returned from |find_sty|.
STY_TYPE type;

/* Is it a valid keyword? */
if((ps = find_sty(map_array,stemp)) == NULL)
	{
	err_print(S,"Invalid style-file keyword; skipping remainder of line");
	sty_line();
	break;
	}

/* Get the next argument. Is its type correct? */
type = ps->type & ~S_MODIFIED;

if(type != next_sty())
	{
	err_print(S,"Argument of keyword \"%s\" has wrong type; \
conversion attempted",ps->keyword);
	}

switch(type)
	{
	case S_INT:
	case S_LONG:
	case S_STRING:
	case S_CHAR:
	break;

	default:
		err_print(S,"Was expecting integer, double-quoted string, \
or single-quoted character here; argument not processed");
		goto processed;
	}

/* Store the argument, check for validity, or process the result in some
way. */
if(ps->init) 
	(*ps->init)(ps); 
else 
	CONFUSION("style keyword","NULL ini fcn");

/* Flag it as modified. */
ps->type |= S_MODIFIED;

processed:;
}

	
@ Initialize a string.  (No error checking.)
@a
SRTN @\
set_str FCN((ps))
	S_MAP HUGE *ps C1("")@;
{
a_str(ps->ptr, (CONST outer_char HUGE *)stemp);
}

@ Here we add a string to an already-existing (non-NULL) one, placing a
newline in between.  If the original string is null, we just initialize it
as usual.

@a
SRTN @\
add_str FCN((ps))
	S_MAP HUGE *ps C1("")@;
{
outer_char HUGE *pa = *(outer_char HUGE **)ps->ptr, HUGE *pb;

if(*pa && (ps->type & S_MODIFIED))
	{
	pb = GET_MEM("add_str", STRLEN(pa) + STRLEN(stemp) + 2, outer_char);
	STRCPY(pb, pa);
	STRCAT(pb, "\n");
	STRCAT(pb, stemp);
	*(outer_char HUGE **)ps->ptr = pb;
	}
else 
	set_str(ps);
}

@ Initialize an integer.  (No error checking.)
@a
SRTN @\
set_int FCN((ps))
	S_MAP HUGE *ps C1("")@;
{
*((int *)ps->ptr) = ATOI(stemp);
}

@ Similarly, initialize a long.  (No error checking.)
@a
SRTN @\
set_long FCN((ps))
	S_MAP HUGE *ps C1("")@;
{
*((long *)ps->ptr) = ATOL(stemp);
}

@ Initialize a character (no error checking).
@a
SRTN @\
set_char FCN((ps))
	S_MAP HUGE *ps C1("")@;
{
*((outer_char *)ps->ptr) = *stemp;
}

@
@<Typedef...@>=

typedef struct
	{
	CONST char *name;
	COLOR value;
	} CLR_MATCH;

CLR_MATCH clr_match[] = {
	{"blue",BLUE},
	{"default",NORMAL},
	{"green",GREEN},
	{"normal",NORMAL},
	{"orange",ORANGE},
	{"red",RED},
	{"yellow",YELLOW},
	{"",NORMAL}
	};

@* VALIDITY CHECKS. 
We begin with an initialization routine for color.  It replaces strings like
\.{"red"} by enumerated values like~|RED|.
@a
SRTN @\
ini_aclr FCN((ps))
	S_MAP HUGE *ps C1("")@;
{
CLR_MATCH HUGE *c;

set_str(ps);

for(c=clr_match; STRCMP(c->name,"") != 0; c++)
	if(STRCMP(c->name,*(outer_char HUGE **)ps->ptr) == 0)
		{
		*(COLOR *)ps->ptr = c->value;
		return;
		}

CLR_PRINTF(warning,("! Color name \"%s\" is invalid; \
replaced by \"default\"\n",(char *)ps->ptr));
mark_harmless;

*(COLOR *)ps->ptr = NORMAL;
}

@ Initialization routine for \.{color.mode}.
@a
SRTN @\
ini_clr FCN((ps))
	S_MAP HUGE *ps C1("")@;
{
set_int(ps);
ini_colors((COLOR_MODE)(*(int *)ps->ptr));
}

@ Initialization routines for file name extension are create via a \WEB\
macro. 

@m EXT_LINK(file,dflt) link0(&wt_style.input_ext.file,OC(dflt),ext_set)

@m INI_EXT(file) 
	SRTN ini_##file FCN((ps))
		CONST S_MAP HUGE *ps C1("")@;
	{
	EXT_LINK(file,(outer_char *)ps->ptr);
	}

@<Unused@>=
/* Actual functions are being created here. */
INI_EXT(web)@;
INI_EXT(change)@;
INI_EXT(hweb)@;
INI_EXT(hchange)@;

@
@a
SRTN @\
ini_ext FCN((ps))
	S_MAP HUGE *ps C1("")@;
{
set_str(ps);
ext_set((CONST outer_char HUGE **)ps->ptr);
}

@ Convert the delimiters for dot constants to |ASCII|.
@a
SRTN @\
ini_dot FCN((ps))
	S_MAP HUGE *ps C1("")@;
{
set_char(ps);
*(ASCII *)ps->ptr = XORD(*(outer_char *)ps->ptr);
}

@
@a
SRTN @\
ini_cchar FCN((ps))
	S_MAP HUGE *ps C1("")@;
{
outer_char c;

set_char(ps);
c = *(outer_char *)ps->ptr;

if(!(c && isprint(c) && c != ' ' && c != '0'))
	{
	*(outer_char *)ps->ptr = CCHAR;
	err_print(S,"Invalid continuation character '%c'; '%c' assumed",
		c,CCHAR);
	}
}

@ Here we check the validity of the line length for Fortran's output.

@a
SRTN @\
ini_output_line_length FCN((ps))
	S_MAP HUGE *ps C1("")@;
{
int output_line_length;

set_int(ps);
output_line_length = *(int *)ps->ptr;

if(output_line_length < MIN_OUTPUT_LINE_LENGTH ||
		output_line_length > MAX_OUTPUT_LINE_LENGTH)
	{
	*(int *)ps->ptr = STANDARD_OUTPUT_LINE_LENGTH;
	err_print(S,"Invalid line length; %d assumed",
		STANDARD_OUTPUT_LINE_LENGTH);
	}
}

@ 
@<Unused@>=
SRTN @\
ini_cdir FCN((ps))
	CONST S_MAP HUGE *ps C1("")@;
{
outer_char *temp;
int n;

temp = GET_MEM("temp_cdir",
	(n=2*STRLEN(*((outer_char HUGE **)ps->ptr)))+1,outer_char); 
esc_buf(temp,temp+n,*((CONST outer_char HUGE **)ps->ptr),stemp,YES);
}

@* INITIALIZING CONTROL CODES.
The control code mapping can be overridden from the style file, although
this is not recommended except in unusual circumstances.

@d ignore 0

@<Glob...@>=

eight_bits ccode[128]; // Meaning of a character following '\.{@@}'.
CONST outer_char *cname[128]; // Associated names of control codes.
CONST ASCII HUGE *at_codes;

@ Here we initialize |ccode| with values that aren't allowed to be changed
by the style file.  The flag |USED_BY_NEITHER| is written into everything
first; if such a control code is encountered during the scan of either
processor, an error message will be issued.

@a
SRTN @\
zero_ccodes(VOID)
@{
int c; // Must be |int|, not |eight_bits|, so the |for| loop will end.

@b
/* Start out by initializing the array to a special flag. */
 for (c=0; c<=127; c++) 
	{
	ccode[c] = USED_BY_NEITHER;
	cname[c] = OC("?");
	}

@<Initialize unchangable codes@>@;
}

@ The following several codes aren't allowed to be changed.
@<Initialize unchangable...@>=
{
ccode[@'@@']=@'@@'; /* `quoted' at sign. This is so fundamental that it
			isn't allowed to be changed by the style file. */

ccode[@'{'] = @'{'; /* Since this is related to the C or \Ratfor\ languages,
			it shouldn't be changed. */
ccode[@'}'] = @'}'; // As above.

ccode[@'>'] = ignore; /* This is historical, and probably dangerous.  But
			it can't be |USED_BY_NEITHER|! */
}

@ The next routine is used by \FWEAVE\ or \FTANGLE\ to initialize the
control code table. Say, for example,
``\.{INI\_CCODE("Aa",begin\_code)}.  If at any point a |ccode|
entry has already been filled in, that means we \It{must} use the default
value. Thus, if the style file has attempted to override that value,
we complain---and abort after we've checked all the initializations.
@a
SRTN @\
ini_ccode FCN((keyword,defaults,code))
	CONST outer_char *keyword C0("The desired keyword.")@;
	CONST outer_char *defaults C0("String of default characters.")@;
	eight_bits code C1("Assign this \FWEB\ universal code")@;
{
CONST outer_char *pc; /* Pointer to the default characters to initialize. */
CONST S_MAP HUGE *m; /* Points to map entry for requested keyword. */
boolean bad_code = NO;
eight_bits cval;
boolean override; /* Are the default values overridden by the style file? */
IN_COMMON outer_char style_file_name[];
ASCII a; // Position in |ccode|.

/* Search for the keyword in the map array. */
if( (m=find_sty(map_array,keyword)) == NULL)
	override = NO; // The keyword isn't even in the table.
else
/* If the style file has set some values for this keyword, and the default
  values for this code are non-zero, then use the values from the style file.
  Otherwise, use the defaults. */
    override = BOOLEAN(*(outer_char **)m->ptr != NULL); 
		// The style file is overriding.

pc = (override && code) ? *(outer_char **)m->ptr : defaults;

/* If we're not ignoring this code completely, assign it to the relevant
values. */
if(code != USED_BY_NEITHER)
   while(*pc)
	{
	if(override && ((cval = ccode[XORD(*pc)]) != USED_BY_NEITHER) )
		{
		printf("! ccode['%c'] already filled with \"%s\"; \
not filled with \"%s\" = \"%s\".\n",
			*pc, (char *)ccode_name(cval), (char *)keyword,
			(char *)ccode_name(code));
		bad_code = YES;
		}

	a = XORD(*pc++);
	ccode[a] = code;
	cname[a] = keyword;
	}

if(bad_code) 
	FATAL(S, 
		"Invalid control code mapping; ",
		"check the style file %s.",
		style_file_name);
}

@ For \FTANGLE, after all the |ccode|s have been assigned, a few of them
must be reinterpreted. For example, by default the codes ``\.{\^.9tT}'' are
all interpreted as |control_text|.
@a
SRTN @\
reassign FCN((old_code,new_code))
	eight_bits old_code C0("")@;
	eight_bits new_code C1("")@;
{
int c;

for(c=0; c<128; c++)
	if(ccode[c] == old_code) 
		ccode[c] = new_code;
}

@ The following array is used for sorting the control-code keywords.
@<Glob...@>=

static CC_BUF HUGE *cc_buf;

@ Here we print out the control code mappings in resonse to \.{-@@}.  They
are printed twice, first alphabetized by the control code, next by the
keyword.  These are printed out side by side.

@a
SRTN @\
prn_codes(VOID)
{
IN_COMMON boolean found_web;
int HUGE *cc_indices;
boolean prn_all = NO;

int k;
int n = 0; // Number of codes to print.

if(!at_codes) 
	return;

puts("Control-code assignments \
([S,D,C]==`Begins [Section,Definition,Code])':");

cc_buf = GET_MEM("cc_buf", 128, CC_BUF);
cc_indices = GET_MEM("cc_indices", 128, int);

if(*at_codes && at_codes[0] == @'*' && at_codes[1] == @'*')
	prn_all = YES;

if(*at_codes && !prn_all)
	{ /* A specific list was given on command line. */
	CONST ASCII *p;

	for(p=at_codes; *p; p++)
		prn0_code(*p, cc_buf, &n);
	}
else
	{ /* Do all of them. */
	ASCII a;

	for(a=0; a<128; a++)
		{
		if(ccode[a] == USED_BY_NEITHER && !prn_all)
			continue;

		prn0_code(a, cc_buf, &n);
		}
	}

FREE_MEM(at_codes, "at_codes", 200, ASCII);

for(k=0; k<n; k++)
	cc_indices[k] = k;

QSORT(cc_indices, n, sizeof(int), cc_cmp);

for(k=0; k<n; k++)
	STRCPY(cc_buf[k][1], cc_buf[cc_indices[k]][0]);
 
for(k=0; k<n; k++)
	printf("%-40s%-40s\n", cc_buf[k][0], cc_buf[k][1]);

FREE_MEM(cc_buf, "cc_buf", 128, CC_BUF);
FREE_MEM(cc_indices, "cc_indices", 128, int);

if(!found_web) 
	wrap_up();
}

@ We alphabetize on the keywords, which follow the `\.{---}'.

@a
int @\
cc_cmp FCN((k0, k1))
	CONST VOID *pk0 C0("")@;
	CONST VOID *pk1 C1("")@;
{
char *s0, *s1;

s0 = strrchr(cc_buf[*(int *)pk0][0], '-');
s1 = strrchr(cc_buf[*(int *)pk1][0], '-');

return STRCMP(s0, s1);
}

@ Print out one control code.
@a
SRTN @\
prn0_code FCN((a, cc_buf, pk))
	ASCII a C0("")@;
	CC_BUF HUGE *cc_buf C0("")@;
	int *pk C1("")@;
{	
ASCII new_module, begin_code, formatt;
ASCII cc = ccode[a];
outer_char c;
int n;
outer_char *letter;

/* The following assumes that these particular codes never change.  This
was easier than including the header files. */
new_module = ccode[@'*'];
begin_code = ccode[@'a'];
formatt = ccode[@'f'];

c = XCHR(a);

if(cc == USED_BY_NEITHER)
	letter = OC("   ");
else if(cc >= new_module)
	letter = OC("[S]");
else if(cc >= begin_code)
	letter = OC("[C]");
else if(cc >= formatt)
	letter = OC("[D]");
else
	letter = OC("   ");

n = NSPRINTF((outer_char *)&cc_buf[*pk][0][0], 
isprint(c) ? "  %s @@%c" : " %s@@'0x%02x'", 
		isprint(c) ? letter : OC(""), c);

switch(c)
	{
   case '/':
	cname[c] = OC("(verbatim comment)");
	break;

   case '>':
	cname[c] = OC("(end of module name)");
	break;

   case '@@':
	cname[c] = OC("(literal '@@')");
	break;
	}

sprintf(&cc_buf[*pk][0][n], " --- %s", (char *)cname[c]);
(*pk)++; // Increment array index.
}

@* COLOR.

@d SET_ACOLOR(field,clr) wt_style.color.field.value = clr

@<Glob...@>=
static outer_char HUGE *termcap; // Name of termcap file.
static outer_char HUGE *tcap_buffer; // Allocated dynamically.

@  Colors are initialized to default values, then overridden for several
built-in palettes.
@a
SRTN @\
ini_colors FCN((color_mode))
	COLOR_MODE color_mode C1("")@;
{
@<Set default colors@>@; // Attach colors to fields.

if(!(termcap=get_termcap())) wt_style.color_mode = color_mode = NO_COLOR;

@<Make default links between bilevel mode and colors@>@;

switch(color_mode)
	{
   case NO_COLOR:
	break;

   case BILEVEL:
	CLR_LINK(YELLOW,md);
	CLR_LINK(GREEN,md);
	CLR_LINK(RED,mdmr);
	break;

   case TRUE_COLOR:
	CLR_LINK(YELLOW,md);
	CLR_LINK(GREEN,us);
	CLR_LINK(BLUE,md);
	CLR_LINK(ORANGE,md);
	CLR_LINK(RED,mdmr);
	break;
	}
}

@ Get control sequence for a color.  This is an ini routine for
\.{color.red} etc.
@a
SRTN @\
ini_bilevel FCN((ps))
	S_MAP HUGE *ps C1("")@;
{
set_str(ps);

if(termcap==NULL) return;

termset(ps->ptr);
}

@ Default color assignments to the various FWEB fields. Change these in the
style file by saying ``\.{color.error = "red"}''.
@<Set default colors@>=
{
SET_ACOLOR(ordinary,NORMAL);
SET_ACOLOR(program_name,YELLOW);
SET_ACOLOR(info,GREEN);
SET_ACOLOR(warning,ORANGE);
SET_ACOLOR(error,RED);
SET_ACOLOR(fatal,RED);
SET_ACOLOR(module_num,ORANGE);
SET_ACOLOR(line_num,ORANGE);
SET_ACOLOR(in_file,YELLOW);
SET_ACOLOR(include_file,BLUE);
SET_ACOLOR(out_file,YELLOW);
SET_ACOLOR(timing,ORANGE);
}

@ Associate a color with a control sequence.

@m CLR_LINK(CLR,id) link0(&wt_style.color._##CLR,OC(#id),termset)

@<Make default links...@>=

CLR_LINK(NORMAL,me);
CLR_LINK(YELLOW,md);
CLR_LINK(GREEN,me);
CLR_LINK(ORANGE,me);
CLR_LINK(RED,mdmr);
CLR_LINK(BLUE,me);

@
@a
SRTN @\
link0 FCN((pp,id,fcn))
	outer_char HUGE **pp C0("")@;
	CONST outer_char HUGE *id C0("")@;
	SRTN (HUGE_FCN_PTR *fcn)PROTO((CONST outer_char HUGE **)) C1("")@;
{
a_str(pp,id); // Allocate space, and store abbreviation string.
(*fcn)((CONST outer_char HUGE **)pp); /* Replace that string by actual escape
					sequences. */
}

@ Similarly, initialize extensions.

@<Finish initializing mappings@>=
{
EXT_LINK(web,"web");
EXT_LINK(change,"ch");
EXT_LINK(hweb,"hweb");
EXT_LINK(hchange,"hch");
}

@ Allocate and store an abbreviation string.
@a
SRTN @\
a_str FCN((pp,id))
	outer_char HUGE **pp C0("")@;
	CONST outer_char HUGE *id C1("")@;
{
@% if(*pp) FREE(*pp); // It's VERY destructive to free memory here!
*((outer_char HUGE * *)pp) = GET_MEM("map_string",STRLEN(id)+1,outer_char); 
STRCPY(*((outer_char HUGE * *)pp),id);
}

@ Open and read the termcap file.

@d ENV_TERM "TERM" // Unix environment variable for terminal type.

@a
outer_char * @\
get_termcap(VOID)
{
#if !HAVE_GETENV
	return NULL;
#else
if((termcap = GETENV(ENV_TERM)) == NULL) return NULL;

tcap_buffer = GET_MEM("tcap_buffer",1024,outer_char);

switch(tgetent(tcap_buffer,termcap))
	{
   case -1:
	printf("! Can't open termcap file %s.\n", (char *)termcap);

   case 0:
	return NULL;
	}

return termcap;
#endif // |HAVE_GETENV|
}

@ On entry, takes as argument a pointer to a string of blank-separated
abbreviations.  On exit, the pointer is changed to point to a |SEQUENCES|
structure that contains the actual escape sequences.

@d NUM_TEMP_PTRS 20

@a
SRTN @\
termset FCN((pid))
	CONST outer_char HUGE **pid C1("")@;
{
outer_char value_buf[500], *area = value_buf; // For |tgetstr|.
outer_char *s;
CONST outer_char HUGE *t;
outer_char id[3];
int k,n;
SEQUENCES HUGE *ps = GET_MEM("termcap struct",1,SEQUENCES);
outer_char *string[NUM_TEMP_PTRS];

if(!termcap) return;

for(t=*pid,n=0; *t; t+=2)
	{
	if(n == NUM_TEMP_PTRS) break;
	while(*t==' ') t++;

/* Put the abbreviation for escape sequence into |id|. */
	STRNCPY(id,t,2);
	TERMINATE(id,2);

/* Get the actual escape sequence from termcap file. */
	if((s=tgetstr(id,&area)) == NULL)
		printf("! Termcap entry \"%s\" not found \
for terminal type \"%s\".\n", (char *)id, (char *)termcap);
	else string[n++] = s;
	}

@<Allocate and initialize memory for the strings@>@;
}

@
@<Allocate and initialize memory for the strings@>=
{
ps->n = (short)n;
ps->string = GET_MEM("termcap strings",n,outer_char *);

for(k=0; k<n; k++)
	{
	ps->string[k] = GET_MEM("termcap string",
		STRLEN(string[k])+1,outer_char);
	STRCPY(ps->string[k],string[k]);
	}

FREE((void *)(*pid));
*pid = (CONST outer_char HUGE *)ps;
}

@ A similar routine processes a blank-delimited list of extensions.
@a
SRTN @\
ext_set FCN((pid))
	CONST outer_char HUGE **pid C1("")@;
{
outer_char id[1000],*p,*p0;
CONST outer_char HUGE *t;
outer_char *string[NUM_TEMP_PTRS];
int k,n;
SEQUENCES HUGE *ps = GET_MEM("termcap struct",1,SEQUENCES);

t = *pid; // Beginning of blank-separated list.
n = 0; // Number of fields found.
p = id; // Start of storage area

while(*t)
	{
	if(n == NUM_TEMP_PTRS) break;
	while(*t == ' ') t++; // Skip initial white space.
	
	p0 = p;
	while(*t != ' ' && *t) *p++ = *t++;
	TERMINATE(p,0);
	p++;
	string[n++] = p0; // Remember where string is.
	}

@<Allocate and init...@>@;
}

@ Used by |tputs|, which is an output routine used to send one character.
We need this intermediate function |put_out| because |putchar| is a macro
on some systems.
@a
int @\
put_out FCN((c))
	int c C1("")@;
{
return putchar(c);
}

@ Output the control sequences corresponding to a color.  This needs to be
generalized for~X.

@m SEND(CLR) tput((SEQUENCES *)wt_style.color._##CLR)

@m CLR_CASE(CLR) 
	case CLR:
	   SEND(CLR);
	   break@;

@a
SRTN @\
set_color FCN((clr))
	COLOR clr C1("")@;
{
color0.last = color0.present; // Save the incoming color, for later restore.

if(wt_style.color_mode != NO_COLOR)
  switch(clr)
	{
	CLR_CASE(NORMAL);
	CLR_CASE(GREEN);
	CLR_CASE(RED);
	CLR_CASE(BLUE);
	CLR_CASE(ORANGE);
	CLR_CASE(YELLOW);

   default:
	SEND(NORMAL);
	break;
	}

color0.present = clr;
}

@ Send each abbreviation in turn.
@a
SRTN @\
tput FCN((ps))
	SEQUENCES *ps C1("")@;
{
int k;

for(k=0; k<ps->n; k++)
	tputs(ps->string[k],1,put_out);
}

@ Print to terminal in particular color.  (This routine is independent of
the particular color mechanism.) \It{Check the variable arguments; they're
not right for Sun-CC yet.}
@<Unused@>=

SRTN @\
clr_printf FCN(VA_ALIST((clr,fmt VA_ARGS)))
	VA_DCL(
	COLOR clr C0("")@;
	outer_char *fmt C2("")@;)@;
{
VA_LIST(arg_ptr)@;

set_color(clr); // Remembers previous color in |color0.last|.

VA_START(arg_ptr,fmt);
vprintf_(fmt,arg_ptr);
va_end(arg_ptr);

set_color(color0.last); // Restore color.
}

@* PRINTING OUT VALUES.
@<Unused@>=
boolean @\
out_map FCN((name))
	outer_char *name C1("")@;
{
outer_char *p;
outer_char key_name[100];
S_MAP *m;

STRCPY(key_name,name);
for(p=key_name; *p; p++)
	if(*p == '.') *p = '_';

for(m=fweb_map; *m->keyword; m++)
	if(STRCMP(m->keyword,key_name) == 0)
		{
		for(p=key_name; *p; p++)
			if(*p == '_') *p = '.';

		printf("%s = ",key_name);
		switch(m->type)
			{
		   case S_STRING:
			if(*(int *)m->ptr < (int)HIGHEST_COLOR)
				printf("%s\n",clr_name[*(int *)m->ptr]);
			else printf("\"%s\"\n",*(char * *)m->ptr);
			break;

		   case S_CHAR:
			printf("'%c'\n",*(char *)m->ptr);
			break;

		   case S_INT:
			printf("%d\n",*(int *)m->ptr);
			break;

		   case S_LONG:
			printf("%ld\n",*(long *)m->ptr);
			break;

		   default:
			printf("INVALID TYPE\n");
			break;
			}

		return YES;
		}

return NO;
}

@ Query the style-file parameters; from \.{-Z}~option.
@a
SRTN @\
see_style FCN((pa,see_all))
	CONST outer_char HUGE *pa C0("")@;
	boolean see_all C1("")@;
{
S_MAP HUGE **s0,HUGE **s,HUGE **s1,HUGE *m;

s0 = GET_MEM("s0",sizeof(fweb_map)/sizeof(S_MAP),S_MAP HUGE *);

/* Fill an array of pointers. */
for(s=s0,m=fweb_map; *(m->keyword); s++,m++)
	*s = m;

/* Sort the array. */
QSORT(s0,s-s0,sizeof(S_MAP HUGE *),cmpr_s_map);

/* Print out the values. */
printf("%s style-file parameters%s%s%s%s:\n",
	see_all ? "Default" : "Modified",
	*pa ? " beginning with \"" : "", (char *)pa, *pa ? "\"" : "",
	see_all ? "\n (null or empty values for colors and \
@@ command codes are misleading)" : "");

if(*pa)
	{ /* Convert \.{'.'} to \.{'\_'}. */
	outer_char HUGE *p;

	for(p=(outer_char HUGE *)pa; *p; p++)
		if(*p == '.')
			*p = '_';
	}

for(s1=s0; s1<s; s1++)
	see_map(*s1,pa,see_all);

FREE_MEM(s0,"s0",sizeof(fweb_map)/sizeof(S_MAP),S_MAP);
}

@
@a
int @\
cmpr_s_map FCN((s0,s1))
	S_MAP HUGE **s0 C0("")@;
	S_MAP HUGE **s1 C1("")@;
{
return STRCMP((*s0)->keyword,(*s1)->keyword);
}

@ Print out an individual style-file parameter.
@a
SRTN @\
see_map FCN((s,pa,see_all))
	S_MAP HUGE *s C0("")@;
	CONST outer_char HUGE *pa C0("")@;
	boolean see_all C1("")@;
{
if(*pa && STRNCMP(pa,s->keyword,STRLEN(pa)) != 0) return;

if(see_all) 
	printf(" ");
else
	{ /* Handled modified parameters. */
	if(s->type & S_MODIFIED) 
		{
		printf("*");
		s->type &= ~S_MODIFIED;
		}

	else return;
	}

printf(" %s = ", (char *)s->keyword);

switch(s->type)
	{
   case S_STRING:
	see_str(*((outer_char **)s->ptr));
	break;

   case S_CHAR:
	printf("'%c'\n",*(outer_char *)s->ptr);
	break;

   case S_INT:
	printf("%d\n",*(int *)s->ptr);
	break;

   case S_LONG:
	printf("%ld\n",*(long *)s->ptr);
	break;

   default:
	break;
	}
}

@
@a
SRTN @\
see_str FCN((s))
	CONST outer_char HUGE *s C1("")@;
{
outer_char c;

if(s==NULL) 
	{
	printf("NULL\n");
	return;
	}
else if(s < (outer_char HUGE *)100) 
	{ /* Horrible kludge to handle stupid color processing. */
	printf("\n");
	return;
	}

printf("\"");

while((c = *s++))
  print_it:
	if(c=='\\') printf("\\\\");
	else if(isprint(c)) printf("%c",c);
	else 
		{
		printf("\\");
		switch(c)
			{
		   case '\a': c = 'a'; goto print_it;
		   case '\b': c = 'b'; goto print_it;
		   case '\f': c = 'f'; goto print_it;
		   case '\n': c = 'n'; goto print_it;
		   case '\r': c = 'r'; goto print_it;
		   case '\t': c = 't'; goto print_it;
		   case '\v': c = 'v'; goto print_it;
		   default:
			printf("%o",c);
			break;
			}
		}

printf("\"\n");
}

@* INDEX.