@z --- style.web ---

FWEB version 1.62 (September 25, 1998)

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 'e': n = '\033'; @+ break; // Non-ANSI (escape).
	   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 @'e': n = @'\033'; @+ break; // Non-ANSI (escape).
	   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_MEM(sprm_buf, "sprm_buf",
					SPRM_LEN, outer_char);

			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); // So default links are set up.
ini_colors(ATOI(get_option(OC("-C"))+2)); // Read \.{-C} option from command line.

@<Finish initializing mappings@>@;
}

@ Obtaining a command-line option.
Command-line arguments are normally processed a bit later in the program.
However, in at least one case (the color mode), one needs to know right
away whether that has been set.  The |get_option| routine scans through all
the command-line arguments, comparing their leading characters against its
string argument, and returns the string if found.

@a

outer_char *
get_option FCN((s))
	outer_char *s C1("")@;
{
int k, len;

len = STRLEN(s);

for(k=1; k<argc; k++)
	if(STRNCMP(s, argv[k], len) == 0)
		return argv[k];

return OC("");
}

@ 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 to %s attempted", ps->keyword, s_type_name[type]);
	}

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

	default:
		err_print(S,"Was expecting %s here; argument not processed",
			s_type_name[type]);
		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[] = {
	{"black", BLACK},
	{"blue", BLUE}, 
	{"cyan", CYAN},
	{"default", NORMAL}, 
	{"green", GREEN}, 
	{"magenta", MAGENTA},
	{"normal", NORMAL}, 
	{"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(WARNINGS, warning, ("! Color name \"%s\" is invalid; \
replaced by \"default\"\n",(char *)ps->ptr));
mark_harmless;

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

@ Initialization routine for \.{color.mode} (no longer used).
@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,"Line length %d is invalid; %d assumed",
		output_line_length,
		STANDARD_OUTPUT_LINE_LENGTH + FORTRAN90_LIKE(language));
	}
}

@ 
@<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)
@B
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;
	/* |ignore| is historical, and probably dangerous.  But
		it can't be |USED_BY_NEITHER|, because some of the routines
		that scan over control text expect this control code to be
		returned from |get_control_code|. */
}

@ 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);
}

@ The |used_by_buf| is used for printing the interpretation of
|USED_BY_OTHER| control codes, which depend on which processor is currently
running.

@m $XLEN(s) $LEN(s)
@m USED_BY_MSG "Used by ftangle"

@<Glob...@>=

outer_char used_by_buf[$XLEN(USED_BY_MSG)+1];

@ 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@@'\\x%02x'", 
		isprint(c) ? letter : OC(""), c);

if(cc == USED_BY_OTHER)
	{
	STRCPY(used_by_buf, "Used by ");
	STRCAT(used_by_buf, program==tangle ? WEAVE : TANGLE);
	cname[c] = used_by_buf;
	}
else if(cc == USED_BY_NEITHER)
	cname[c] = OC("Unassigned");
else 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 *tcap_buffer; // Allocated dynamically.

@  Colors are initialized to default values, then overridden for several
built-in palettes.
@a
COLOR_MODE @\
ini_colors FCN((color_mode0))
	COLOR_MODE color_mode0 C1("")@;
{
color_mode = color_mode0;

@<Set default colors@>@; // Attach colors to fields.

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

new_color:
switch(color_mode)
	{
   case NO_COLOR:
	@<Make default links between bilevel mode and colors@>@;
	break;

   case ANSI_COLOR:
	CLR_LINK1(NORMAL, "\033[0m");
	CLR_LINK1(BLACK, "\033[01;30m");
	CLR_LINK1(RED, "\033[01;31m");
	CLR_LINK1(GREEN, "\033[01;32m");
	CLR_LINK1(YELLOW, "\033[01;33m");
	CLR_LINK1(BLUE, "\033[01;34m"); 
	CLR_LINK1(MAGENTA, "\033[01;35m");
	CLR_LINK1(CYAN, "\033[01;36m");
	CLR_LINK1(WHITE, "\033[01;37m");
	break;

   case BILEVEL:
	CLR_LINK(NORMAL, me);
	CLR_LINK(BLACK, me);
	CLR_LINK(RED, mdmr);
	CLR_LINK(GREEN, md);
	CLR_LINK(YELLOW, md);
	CLR_LINK(BLUE, me);
	CLR_LINK(MAGENTA, me);
	CLR_LINK(CYAN, me);
	CLR_LINK(WHITE, mr);
	break;

   case TRILEVEL:
	CLR_LINK(NORMAL, me);
	CLR_LINK(BLACK, me);
	CLR_LINK(RED, mdmr);
	CLR_LINK(GREEN, md);
	CLR_LINK(YELLOW, md);
	CLR_LINK(BLUE, usmd);
	CLR_LINK(MAGENTA, me);
	CLR_LINK(CYAN, us);
	CLR_LINK(WHITE, mr);
	break;

   case USER_COLORS:
	break;

   default:
	beeps = YES; // Not set yet from the style file.
	printf("!%c Color mode %i is invalid; replaced by 0.\n",
		beep(1), color_mode); // Can't be in color; defaults not set yet.
	beeps = BEEPS;
	color_mode = NO_COLOR;
	goto new_color;
	}

return color_mode;
}

@ 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, CYAN);
SET_ACOLOR(md_name, CYAN);
SET_ACOLOR(info, GREEN);
SET_ACOLOR(warning, YELLOW);
SET_ACOLOR(error, RED);
SET_ACOLOR(fatal, RED);
SET_ACOLOR(module_num, MAGENTA);
SET_ACOLOR(line_num, MAGENTA);
SET_ACOLOR(in_file, CYAN);
SET_ACOLOR(include_file, BLUE);
SET_ACOLOR(out_file, CYAN);
SET_ACOLOR(timing, MAGENTA);
SET_ACOLOR(character, MAGENTA);
}

@ Associate a color with a control sequence.
`\.{me}'---turn off all appearance modes.
`\.{md}'---double-bright mode.
`\.{mr}'---reverse video.

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

@<Make default links...@>=
{
CLR_LINK(NORMAL, me);
CLR_LINK(BLACK, me);
CLR_LINK(RED, mdmr);
CLR_LINK(GREEN, me);
CLR_LINK(YELLOW, md);
CLR_LINK(BLUE, me);
CLR_LINK(MAGENTA, me);
CLR_LINK(CYAN, me);
CLR_LINK(WHITE, mr);
}

@
@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, len;
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+=len)
	{
	if(n == NUM_TEMP_PTRS) 
		break;

	while(*t==' ') 
		t++;

#if 0
	printf("TERMSET:  <0%o>: `%s'\n", t[0], t+1);
#endif

	if(*t == ESC)
		{ /* Kludge:  Recognized a hard-coded escape sequence. */
		len = STRLEN(t);
		string[n++] = (outer_char *)t;
		}
	else
		@<Get escape sequence from termcap file@>@;
	}

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

@
@<Get escape...@>=
{
/* Put the abbreviation for escape sequence into |id|. */
len = 2;
STRNCPY(id, t, len);
TERMINATE(id, len);

/* 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@>=
{
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) put_((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.

#define put_ tput

if(color_mode)
  switch(clr)
	{
	CLR_CASE(NORMAL);
	CLR_CASE(BLACK);
	CLR_CASE(RED);
	CLR_CASE(GREEN);
	CLR_CASE(YELLOW);
	CLR_CASE(BLUE);
	CLR_CASE(MAGENTA);
	CLR_CASE(CYAN);
	CLR_CASE(WHITE);

   default:
	SEND(NORMAL);
	break;
	}

#undef put_

color0.present = clr;
}

@
@a
outer_char * @\
sset_color FCN((clr))
	COLOR clr C1("")@;
{
#define put_ return sput

if(color_mode)
  switch(clr)
	{
	CLR_CASE(NORMAL);
	CLR_CASE(BLACK);
	CLR_CASE(RED);
	CLR_CASE(GREEN);
	CLR_CASE(YELLOW);
	CLR_CASE(BLUE);
	CLR_CASE(MAGENTA);
	CLR_CASE(CYAN);
	CLR_CASE(WHITE);

   default:
	SEND(NORMAL);
	break;
	}

#undef put_

return OC("");
}

@ 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);
}

@ As above, but for writing to strings.
@a
outer_char * @\
sput FCN((ps))
	SEQUENCES *ps C1("")@;
{
int k;
outer_char temp[100], *temp1;

if(color_mode == NO_COLOR)
	return OC("");

STRCPY(temp, ps->string[0]);

for(k=1; k<ps->n; k++)
	STRCAT(temp, ps->string[k]);

temp1 = GET_MEM("sput buf", STRLEN(temp)+1, outer_char);
STRCPY(temp1, temp);

return push_buf(&sput_buf, temp1); // This needs to be freed at some point!
}


@ 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. */
SET_COLOR(info);
printf("%s style-file parameters%s%s%s%s:\n",
	see_all ? "Default" : "Modified",
	*pa ? " beginning with \"" : "", (char *)pa, *pa ? "\"" : "",
#if 0
	see_all // Got tired of reading this; nobody cares anyway.
#endif
	0 ? "\n (null or empty values for \
@@ command codes are misleading)" : "");

SET_COLOR(ordinary);

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("")@;
{
SEQUENCES *ps;
int k;
STY_TYPE type;
boolean modified = NO;
boolean is_color;

if(*pa && STRNCMP(pa, s->keyword, STRLEN(pa)) != 0) 
	return;

ps = NULL;

if(see_all)
	modified = NO;
else
	modified = s->type & S_MODIFIED;

/* The |S_CLR| type handles parameters that are arrays of strings. */
if(STRNCMP(s->keyword, "Color", 5) == 0)
	{
	ps = (SEQUENCES *)(*(outer_char **)s->ptr);

	if(see_all)
		type = S_CLR;
	else if(color_mode == USER_COLORS)
		type = S_CLR | modified;
	else
		type = S_CLR_MOD;
	}
else if(STRNCMP(s->keyword, "ext", 3) == 0)
	{
	ps = NULL;
	type = S_CLR | modified;
	}
else
	type = s->type;

if(see_all) 
	printf(" ");
else
	{ /* Handled modified parameters. */
	if(type & S_MODIFIED) 
		{
		CLR_PRINTF(ALWAYS, warning, 
			((type == S_CLR_MOD && !modified ? " " : "*")));
		type &= ~S_MODIFIED; 
			// Convert to ordinary type like |S_STRING|. 
		}

	else return;
	}

is_color = (type == S_STRING) 
	&& *(int *)s->ptr > NULL_COLOR && *(int *)s->ptr < (int)HIGHEST_COLOR;

if(color_mode)
if(ps)
	tput(ps); // Print color parameters in color!
else if(is_color)
	set_color(*(int *)s->ptr);

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

switch(type)
	{
   case S_STRING:
	if(is_color)
		printf("\"%s\"\n",clr_name[*(int *)s->ptr]);
	else
		see_str(*((outer_char **)s->ptr), OC("\n"));
	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;

   case S_CLR:
	ps = (SEQUENCES *)(*(outer_char **)s->ptr);
	
	for(k=0; k<ps->n; k++)
		see_str(ps->string[k], OC(" "));
	puts("");
	break;

   default:
	break;
	}

SET_COLOR(ordinary);
}

@
@a
SRTN @\
see_str FCN((s, eos))
	CONST outer_char HUGE *s C0("")@;
	CONST outer_char *eos 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.  (Maybe no
		longer necessary.) */
	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;
		   case '\033':  c = 'e'; goto print_it; // Escape.
		   default:
			printf("%o",c);
			break;
			}
		}

printf("\"");
printf("%s", eos);
}

@* INDEX.
