/*=gfunc find_file
*
* what: locate a file in the search path
* exparg: file-name, name of file with text
* exparg: @suffix @ file suffix to try, too @ opt @
*
* doc:
*
* AutoGen has a search path that it uses to locate template and definition
* files. This function will search the same list for @file{file-name}, both
* with and without the @file{.suffix}, if provided.
=*/
SCM
ag_scm_find_file(SCM file, SCM suffix)
{
SCM res = SCM_UNDEFINED;
if (! AG_SCM_STRING_P(file))
scm_wrong_type_arg(FIND_FILE_NAME, 1, file);
{
char z[ AG_PATH_MAX+1 ];
char const * pz = ag_scm2zchars(file, "file-name");
/*
* The suffix is optional. If provided, it will be a string.
*/
if (AG_SCM_STRING_P(suffix)) {
char* apz[2];
apz[0] = (char *)ag_scm2zchars(suffix, "file suffix");
apz[1] = NULL;
if (SUCCESSFUL(findFile(pz, z, (char const **)apz, NULL)))
res = AG_SCM_STR02SCM(z);
} else if (SUCCESSFUL(findFile(pz, z, NULL, NULL)))
res = AG_SCM_STR02SCM(z);
}
return res;
}
/*=gfunc tpl_file
*
* what: get the template file name
*
* exparg: full_path, include full path to file, optonal
*
* doc: Returns the name of the current template file.
* If @code{#t} is passed in as an argument, then the template
* file is hunted for in the template search path. Otherwise,
* just the unadorned name.
=*/
SCM
ag_scm_tpl_file(SCM full)
{
if (AG_SCM_BOOL_P(full) && AG_SCM_NFALSEP(full)) {
static char const * const sfx[] = { "tpl", NULL };
char z[AG_PATH_MAX];
if (SUCCESSFUL(findFile(pzTemplFileName, z, sfx, NULL)))
return AG_SCM_STR02SCM(z);
}
return AG_SCM_STR02SCM((char*)(void*)pzTemplFileName);
}
/*=gfunc stack
*
* what: make list of AutoGen values
*
* exparg: ag-name, AutoGen value name
*
* doc: Create a scheme list of all the strings that are associated
* with a name. They must all be text values or we choke.
=*/
SCM
ag_scm_stack(SCM obj)
{
SCM res;
SCM * pos = &res;
def_ent_t ** ppDE;
def_ent_t * pDE;
SCM str;
res = SCM_EOL;
ppDE = find_def_ent_list(ag_scm2zchars(obj, "AG Object"));
if (ppDE == NULL)
return SCM_EOL;
for (;;) {
pDE = *(ppDE++);
if (pDE == NULL)
break;
if (pDE->de_type != VALTYP_TEXT)
return SCM_UNDEFINED;
str = AG_SCM_STR02SCM(pDE->de_val.dvu_text);
*pos = scm_cons(str, SCM_EOL);
pos = SCM_CDRLOC(*pos);
}
return res;
}
/*=gfunc stack
*
* what: make list of AutoGen values
*
* exparg: ag-name, AutoGen value name
*
* doc: Create a scheme list of all the strings that are associated
* with a name. They must all be text values or we choke.
=*/
SCM
ag_scm_stack(SCM obj)
{
SCM res;
SCM * pos = &res;
tDefEntry** ppDE;
tDefEntry* pDE;
SCM str;
res = SCM_EOL;
ppDE = findEntryList(ag_scm2zchars(obj, "AG Object"));
if (ppDE == NULL)
return SCM_EOL;
for (;;) {
pDE = *(ppDE++);
if (pDE == NULL)
break;
if (pDE->valType != VALTYP_TEXT)
return SCM_UNDEFINED;
str = AG_SCM_STR02SCM(pDE->val.pzText);
*pos = scm_cons(str, SCM_EOL);
pos = SCM_CDRLOC(*pos);
}
return res;
}
/*=gfunc get
*
* what: get named value
*
* exparg: ag-name, name of AutoGen value
* exparg: alt-val, value if not present, optional
*
* doc:
* Get the first string value associated with the name.
* It will either return the associated string value (if
* the name resolves), the alternate value (if one is provided),
* or else the empty string.
=*/
SCM
ag_scm_get(SCM agName, SCM altVal)
{
tDefEntry* pE;
ag_bool x;
if (! AG_SCM_STRING_P(agName))
pE = NULL;
else pE = findDefEntry(ag_scm2zchars(agName, "ag value"), &x);
if ((pE == NULL) || (pE->valType != VALTYP_TEXT)) {
if (AG_SCM_STRING_P(altVal))
return altVal;
return AG_SCM_STR02SCM(zNil);
}
return AG_SCM_STR02SCM(pE->val.pzText);
}
/*=gfunc c_string
*
* what: emit string for ANSI C
* general_use:
*
* exparg: string, string to reformat
*
* doc:
* Reform a string so that, when printed, the C compiler will be able to
* compile the data and construct a string that contains exactly what the
* current string contains. Many non-printing characters are replaced with
* escape sequences. Newlines are replaced with a backslash, an @code{n}, a
* closing quote, a newline, seven spaces and another re-opening quote. The
* compiler will implicitly concatenate them. The reader will see line
* breaks.
*
* A K&R compiler will choke. Use @code{kr-string} for that compiler.
*
=*/
SCM
ag_scm_c_string(SCM str)
{
char const * pz = ag_scm2zchars(str, "cstr");
SCM res;
pz = optionQuoteString(pz, C_STRING_NEWLINE);
res = AG_SCM_STR02SCM(pz);
AGFREE(pz);
return res;
}
/**
* guts of the template file/line functions
*/
static SCM
do_tpl_file_line(int line_delta, char const * fmt)
{
void * args[2] = {
[0] = (void*)pCurTemplate->pzTplFile,
[1] = (void*)((long)pCurMacro->lineNo + line_delta)
};
char * buf = strrchr(args[0], DIRCH);
if (buf != NULL)
args[0] = buf + 1;
{
size_t sz = strlen(fmt) + strlen(args[0]) + 24;
buf = ag_scribble(sz);
}
sprintfv(buf, fmt, (snv_constpointer*)args);
return AG_SCM_STR02SCM(buf);
}
/**
* Could not find the file or could not find the markers.
* Either way, emit an empty enclosure.
*/
static SCM
mk_empty_text(char const* pzStart, char const* pzEnd, SCM def)
{
size_t mlen = strlen(pzStart) + strlen(pzEnd) + 3;
char* pzOut;
if (! AG_SCM_STRING_P(def)) {
pzOut = ag_scribble(mlen);
sprintf(pzOut, LINE_CONCAT3_FMT+3, pzStart, pzEnd);
} else {
char const * pzDef = ag_scm2zchars(def, "dft extr str");
mlen += AG_SCM_STRLEN(def) + 1;
pzOut = ag_scribble(mlen);
sprintf(pzOut, LINE_CONCAT3_FMT, pzStart, pzDef, pzEnd);
}
return AG_SCM_STR02SCM(pzOut);
}
/*=gfunc def_file_line
*
* what: get a definition file+line number
*
* exparg: ag-name, name of AutoGen value
* exparg: msg-fmt, formatting for line message, optional
*
* doc:
* Returns the file and line number of a AutoGen defined value, using
* either the default format, "from %s line %d", or else the format you
* supply. For example, if you want to insert a "C" language file-line
* directive, you would supply the format "# %2$d \"%1$s\"", but that
* is also already supplied with the scheme variable
* @xref{SCM c-file-line-fmt}. You may use it thus:
*
* @example
* (def-file-line "ag-def-name" c-file-line-fmt)
* @end example
*
* It is also safe to use the formatting string, "%2$d". AutoGen uses
* an argument vector version of printf: @xref{snprintfv}.
=*/
SCM
ag_scm_def_file_line(SCM obj, SCM fmt)
{
static char const zFmt[] = "from %s line %d";
char const * pzFmt = zFmt;
char * buf;
ag_bool x;
tDefEntry * pE = findDefEntry(ag_scm2zchars(obj, "ag value"), &x);
/*
* IF we did not find the entry we are looking for
* THEN return UNDEFINED
*/
if (pE == NULL)
return SCM_UNDEFINED;
if (AG_SCM_STRING_P(fmt))
pzFmt = ag_scm2zchars(fmt, "file/line format");
{
void * args[2] = {
(void*)pE->pzSrcFile,
(void*)(long)pE->srcLineNum
};
size_t maxlen;
buf = strrchr(args[0], DIRCH);
if (buf != NULL)
args[0] = buf + 1;
maxlen = strlen(args[0]) + strlen(pzFmt) + LOG10_2to32 + 1;
buf = ag_scribble(maxlen);
sprintfv(buf, pzFmt, (snv_constpointer*)args);
}
return AG_SCM_STR02SCM(buf);
}
/*=gfunc suffix
*
* what: get the current suffix
*
* doc:
* Returns the current active suffix (@pxref{pseudo macro}).
=*/
SCM
ag_scm_suffix(void)
{
return AG_SCM_STR02SCM((char*)pzCurSfx);
}
/*=gfunc def_file
*
* what: definitions file name
*
* doc: Get the name of the definitions file.
* Returns the name of the source file containing the AutoGen
* definitions.
=*/
SCM
ag_scm_def_file(void)
{
return AG_SCM_STR02SCM((char*)(void*)pBaseCtx->pzCtxFname);
}
/*=gfunc base_name
*
* what: base output name
*
* doc: Returns a string containing the base name of the output file(s).
* Generally, this is also the base name of the definitions file.
=*/
SCM
ag_scm_base_name(void)
{
return AG_SCM_STR02SCM((char*)(void*)OPT_ARG(BASE_NAME));
}
/**
* Find a definition with a specific value
*/
static SCM
find_entry_value(SCM op, SCM obj, SCM test)
{
static char const zFailed[] = "failed\n";
static char const zSucc[] = "SUCCESS\n";
ag_bool isIndexed;
tDefEntry* pE;
char* pzField;
{
char * name = ag_scm2zchars(obj, "find name");
if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS)
fprintf(pfTrace, " in \"%s\" -- ", name);
pzField = strchr(name, name_sep_ch);
if (pzField != NULL)
*(pzField++) = NUL;
pE = findDefEntry(name, &isIndexed);
}
/*
* No such entry? return FALSE
*/
if (pE == NULL) {
if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS)
fputs(zFailed, pfTrace);
return SCM_BOOL_F;
}
/*
* No subfield? Check the values
*/
if (pzField == NULL) {
SCM result;
SCM field;
if (pE->valType != VALTYP_TEXT) {
if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS)
fputs(zFailed, pfTrace);
return SCM_BOOL_F; /* Cannot match string -- not a text value */
}
field = AG_SCM_STR02SCM(pE->val.pzText);
result = AG_SCM_APPLY2(op, field, test);
if (! isIndexed)
while (result == SCM_BOOL_F) {
pE = pE->pTwin;
if (pE == NULL)
break;
field = AG_SCM_STR02SCM(pE->val.pzText);
result = AG_SCM_APPLY2(op, field, test);
}
if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS)
fputs((result == SCM_BOOL_T) ? zSucc : zFailed, pfTrace);
return result;
}
/*
* a subfield for a text macro? return FALSE
*/
if (pE->valType == VALTYP_TEXT) {
if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS)
fputs(zFailed, pfTrace);
return SCM_BOOL_F;
}
/*
* Search the members for what we want.
*/
pzField[-1] = name_sep_ch;
{
SCM field = AG_SCM_STR02SCM(pzField);
SCM result;
tDefCtx ctx = currDefCtx;
currDefCtx.pPrev = &ctx;
currDefCtx.pDefs = pE->val.pDefEntry;
result = find_entry_value(op, field, test);
if (! isIndexed)
while (result == SCM_BOOL_F) {
pE = pE->pTwin;
if (pE == NULL)
break;
currDefCtx.pDefs = pE->val.pDefEntry;
result = find_entry_value(op, field, test);
}
currDefCtx = ctx;
return result;
}
}
/*=gfunc raw_shell_str
*
* what: single quote shell string
* general_use:
*
* exparg: string, string to transform
*
* doc:
* Convert the text of the string into a singly quoted string
* that a normal shell will process into the original string.
* (It will not do macro expansion later, either.)
* Contained single quotes become tripled, with the middle quote
* escaped with a backslash. Normal shells will reconstitute the
* original string.
*
* @strong{Notice}: some shells will not correctly handle unusual
* non-printing characters. This routine works for most reasonably
* conventional ASCII strings.
=*/
SCM
ag_scm_raw_shell_str(SCM obj)
{
char * data;
char * pz;
char * pzFree;
data = ag_scm2zchars(obj, "AG Object");
{
size_t dtaSize = AG_SCM_STRLEN(obj) + 3; /* NUL + 2 quotes */
pz = data-1;
for (;;) {
pz = strchr(pz+1, '\'');
if (pz == NULL)
break;
dtaSize += 3; /* '\'' -> 3 additional chars */
}
pzFree = pz = AGALOC(dtaSize + 2, "raw string");
}
/*
* Handle leading single quotes before starting the first quote.
*/
while (*data == '\'') {
*(pz++) = '\\';
*(pz++) = '\'';
/*
* IF pure single quotes, then we're done.
*/
if (*++data == NUL) {
*pz = NUL;
goto returnString;
}
}
/*
* Start quoting. If the string is empty, we wind up with two quotes.
*/
*(pz++) = '\'';
for (;;) {
switch (*(pz++) = *(data++)) {
case NUL:
goto loopDone;
case '\'':
/*
* We've inserted a single quote, which ends the quoting session.
* Now, insert escaped quotes for every quote char we find, then
* restart the quoting.
*/
data--;
do {
*(pz++) = '\\';
*(pz++) = '\'';
} while (*++data == '\'');
if (*data == NUL) {
*pz = NUL;
goto returnString;
}
*(pz++) = '\'';
}
} loopDone:;
pz[-1] = '\'';
*pz = NUL;
returnString:
{
SCM res = AG_SCM_STR02SCM(pzFree);
AGFREE(pzFree);
return res;
}
}
/*=gfunc join
*
* what: join string list with separator
* general_use:
* exparg: separator, string to insert between entries
* exparg: list, list of strings to join,, list
*
* doc: With the first argument as the separator string,
* joins together an a-list of strings into one long string.
* The list may contain nested lists, partly because you
* cannot always control that.
=*/
SCM
ag_scm_join(SCM sep, SCM list)
{
int l_len, sv_l_len;
SCM car;
SCM alist = list;
size_t sep_len;
size_t str_len;
char * pzRes;
char const * pzSep;
char * pzScan;
if (! AG_SCM_STRING_P(sep))
return SCM_UNDEFINED;
sv_l_len = l_len = (int)scm_ilength(list);
if (l_len == 0)
return AG_SCM_STR02SCM(zNil);
pzSep = scm_i_string_chars(sep);
sep_len = AG_SCM_STRLEN(sep);
str_len = 0;
/*
* Count up the lengths of all the strings to be joined.
*/
for (;;) {
car = SCM_CAR(list);
list = SCM_CDR(list);
/*
* This routine is listed as getting a list as the second
* argument. That means that if someone builds a list and
* hands it to us, it magically becomes a nested list.
* This unravels that.
*/
if (! AG_SCM_STRING_P(car)) {
if (car != SCM_UNDEFINED)
car = ag_scm_join(sep, car);
if (! AG_SCM_STRING_P(car))
return SCM_UNDEFINED;
}
str_len += AG_SCM_STRLEN(car);
if (--l_len <= 0)
break;
str_len += sep_len;
}
l_len = sv_l_len;
pzRes = pzScan = scribble_get((ssize_t)str_len);
/*
* Now, copy each one into the output
*/
for (;;) {
size_t cpy_len;
car = SCM_CAR(alist);
alist = SCM_CDR(alist);
/*
* This unravels nested lists.
*/
if (! AG_SCM_STRING_P(car))
car = ag_scm_join(sep, car);
cpy_len = AG_SCM_STRLEN(car);
memcpy(VOIDP(pzScan), scm_i_string_chars(car), cpy_len);
pzScan += cpy_len;
/*
* IF we reach zero, then do not insert a separation and bail out
*/
if (--l_len <= 0)
break;
memcpy(VOIDP(pzScan), VOIDP(pzSep), sep_len);
pzScan += sep_len;
}
return AG_SCM_STR2SCM(pzRes, str_len);
}
static SCM
makeString(char const * pzText, char const * pzNewLine, size_t newLineSize)
{
char z[SCRIBBLE_SIZE];
char* pzDta;
char* pzFre;
char const * pzScn = pzText;
size_t dtaSize = string_size(pzText, newLineSize);
/*
* We now know how big the string is going to be.
* Allocate what we need.
*/
if (dtaSize >= sizeof(z))
pzFre = pzDta = AGALOC(dtaSize, "quoting string");
else pzFre = pzDta = z;
*(pzDta++) = '"';
for (;;) {
unsigned char ch = (unsigned char)*pzScn;
if ((ch >= ' ') && (ch <= '~')) {
if ((ch == '"') || (ch == '\\'))
/*
* We must escape these characters in the output string
*/
*(pzDta++) = '\\';
*(pzDta++) = ch;
} else switch (ch) {
case NUL:
goto copyDone;
case NL:
/*
* place contiguous new-lines on a single line
*/
while (pzScn[1] == NL) {
*(pzDta++) = '\\';
*(pzDta++) = 'n';
pzScn++;
}
/*
* Replace the new-line with its escaped representation.
* Also, break and restart the output string, indented
* 7 spaces (so that after the '"' char is printed,
* any contained tabbing will look correct).
* Do *not* start a new line if there are no more data.
*/
if (pzScn[1] == NUL) {
*(pzDta++) = '\\';
*(pzDta++) = 'n';
goto copyDone;
}
strcpy(pzDta, pzNewLine);
pzDta += newLineSize;
break;
case '\a':
*(pzDta++) = '\\';
*(pzDta++) = 'a';
break;
case '\b':
*(pzDta++) = '\\';
*(pzDta++) = 'b';
break;
case '\f':
*(pzDta++) = '\\';
*(pzDta++) = 'f';
break;
case '\r':
*(pzDta++) = '\\';
*(pzDta++) = 'r';
break;
case TAB:
*(pzDta++) = '\\';
*(pzDta++) = 't';
break;
case '\v':
*(pzDta++) = '\\';
*(pzDta++) = 'v';
break;
default:
/*
* sprintf is safe here, because we already computed
* the amount of space we will be using.
*/
sprintf(pzDta, MK_STR_OCT_FMT, ch);
pzDta += 4;
}
pzScn++;
} copyDone:
/*
* End of string. Terminate the quoted output.
* If necessary, deallocate the text string.
* Return the scan resumption point.
*/
*(pzDta++) = '"';
*pzDta = NUL;
{
SCM res = AG_SCM_STR02SCM(pzFre);
if (pzFre != z)
AGFREE(pzFre);
return res;
}
}