/*=gfunc in_p
*
* what: test for string in list
* general_use:
* exparg: test-string, string to look for
* exparg: string-list, list of strings to check,, list
*
* doc: Return SCM_BOOL_T if the first argument string is found
* in one of the entries in the second (list-of-strings) argument.
=*/
SCM
ag_scm_in_p(SCM obj, SCM list)
{
int len;
size_t lenz;
SCM car;
char const * pz1;
if (! AG_SCM_STRING_P(obj))
return SCM_UNDEFINED;
pz1 = AG_SCM_CHARS(obj);
lenz = AG_SCM_STRLEN(obj);
/*
* If the second argument is a string somehow, then treat
* this as a straight out string comparison
*/
if (AG_SCM_STRING_P(list)) {
if ( (AG_SCM_STRLEN(list) == lenz)
&& (strncmp(pz1, AG_SCM_CHARS(list), lenz) == 0))
return SCM_BOOL_T;
return SCM_BOOL_F;
}
len = scm_ilength(list);
if (len == 0)
return SCM_BOOL_F;
/*
* Search all the lists and sub-lists passed in
*/
while (len-- > 0) {
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 (ag_scm_in_p(obj, car) == SCM_BOOL_T)
return SCM_BOOL_T;
continue;
}
if ( (AG_SCM_STRLEN(car) == lenz)
&& (strncmp(pz1, AG_SCM_CHARS(car), lenz) == 0) )
return SCM_BOOL_T;
}
return SCM_BOOL_F;
}
/*=gfunc string_tr
*
* what: convert characters with new result
* general_use:
*
* exparg: source, string to transform
* exparg: match, characters to be converted
* exparg: translation, conversion list
*
* doc: This is identical to @code{string-tr!}, except that it does not
* over-write the previous value.
=*/
SCM
ag_scm_string_tr(SCM Str, SCM From, SCM To)
{
size_t lenz = AG_SCM_STRLEN(Str);
SCM res = AG_SCM_STR2SCM(AG_SCM_CHARS(Str), lenz);
return ag_scm_string_tr_x(res, From, To);
}
/*=gfunc string_tr_x
*
* what: convert characters
* general_use:
*
* exparg: source, string to transform
* exparg: match, characters to be converted
* exparg: translation, conversion list
*
* doc: This is the same as the @code{tr(1)} program, except the
* string to transform is the first argument. The second and
* third arguments are used to construct mapping arrays for the
* transformation of the first argument.
*
* It is too bad this little program has so many different
* and incompatible implementations!
=*/
SCM
ag_scm_string_tr_x(SCM str, SCM from_xform, SCM to_xform)
{
unsigned char ch_map[ 1 << 8 /* bits-per-byte */ ];
int i = sizeof(ch_map) - 1;
char* pzFrom = ag_scm2zchars(from_xform, "str");
char* pzTo = ag_scm2zchars(to_xform, "str");
do {
ch_map[i] = i;
} while (--i > 0);
for (;i <= sizeof(ch_map) - 1;i++) {
unsigned char fch = (unsigned char)*(pzFrom++);
unsigned char tch = (unsigned char)*(pzTo++);
if (tch == NUL) {
pzTo--;
tch = pzTo[-1];
}
switch (fch) {
case NUL:
goto mapDone;
case '-':
if ((i > 0) && (tch == '-')) {
unsigned char fs = (unsigned char)pzFrom[-2];
unsigned char fe = (unsigned char)pzFrom[0];
unsigned char ts = (unsigned char)pzTo[-2];
unsigned char te = (unsigned char)pzTo[0];
if (te != NUL) {
while (fs < fe) {
ch_map[ fs++ ] = ts;
if (ts < te) ts++;
}
break;
}
}
default:
ch_map[ fch ] = tch;
}
} mapDone:;
pzTo = (char*)(void*)AG_SCM_CHARS(str);
i = AG_SCM_STRLEN(str);
while (i-- > 0) {
*pzTo = ch_map[ (int)*pzTo ];
pzTo++;
}
return str;
}
/*=gfunc time_string_to_number
*
* what: duration string to seconds
* general_use:
* exparg: time_spec, string to parse
*
* doc: Convert the argument string to a time period in seconds.
* The string may use multiple parts consisting of days, hours
* minutes and seconds. These are indicated with a suffix of
* @code{d}, @code{h}, @code{m} and @code{s} respectively.
* Hours, minutes and seconds may also be represented with
* @code{HH:MM:SS} or, without hours, as @code{MM:SS}.
=*/
SCM
ag_scm_time_string_to_number(SCM time_spec)
{
extern time_t parse_duration(char const * in_pz);
char const * pz;
time_t time_period;
if (! AG_SCM_STRING_P(time_spec))
return SCM_UNDEFINED;
pz = AG_SCM_CHARS(time_spec);
time_period = parse_duration(pz);
return AG_SCM_INT2SCM((int)time_period);
}
/*=gfunc string_substitute
*
* what: multiple global replacements
* general_use:
*
* exparg: source, string to transform
* exparg: match, substring or substring list to be replaced
* exparg: repl, replacement strings or substrings
*
* doc: @code{match} and @code{repl} may be either a single string or
* a list of strings. Either way, they must have the same structure
* and number of elements. For example, to replace all amphersands,
* less than and greater than characters, do something like this:
*
* @example
* (string-substitute source
* (list "&" "<" ">")
* (list "&" "<" ">"))
* @end example
=*/
SCM
ag_scm_string_substitute(SCM Str, SCM Match, SCM Repl)
{
char const * pzStr;
ssize_t len;
SCM res;
if (! AG_SCM_STRING_P(Str))
return SCM_UNDEFINED;
pzStr = AG_SCM_CHARS(Str);
len = AG_SCM_STRLEN(Str);
if (AG_SCM_STRING_P(Match))
do_substitution(pzStr, len, Match, Repl, (char**)&pzStr, &len);
else
do_multi_subs((char**)&pzStr, &len, Match, Repl);
res = AG_SCM_STR2SCM(pzStr, len);
return res;
}
/**
* The template output goes to stdout. Perhaps because output
* is for a CGI script. In any case, this case must be handled
* specially.
*/
static void
do_stdout_tpl(tTemplate * pTF)
{
char const * pzRes;
SCM res;
pzLastScheme = NULL; /* We cannot be in Scheme processing */
switch (setjmp (fileAbort)) {
case SUCCESS:
break;
case PROBLEM:
if (*pzOopsPrefix != NUL) {
fprintf(stdout, DO_STDOUT_TPL_ABANDONED, pzOopsPrefix);
pzOopsPrefix = zNil;
}
fclose(stdout);
return;
default:
fprintf(stdout, DO_STDOUT_TPL_BADR, pzOopsPrefix);
case FAILURE:
exit(EXIT_FAILURE);
}
pzCurSfx = DO_STDOUT_TPL_NOSFX;
currDefCtx = rootDefCtx;
pCurFp = &fpRoot;
fpRoot.pFile = stdout;
fpRoot.pzOutName = DO_STDOUT_TPL_STDOUT;
fpRoot.flags = FPF_NOUNLINK | FPF_STATIC_NM;
if (OPT_VALUE_TRACE >= TRACE_EVERYTHING)
fputs(DO_STDOUT_TPL_START_STD, pfTrace);
/*
* IF there is a CGI prefix for error messages,
* THEN divert all output to a temporary file so that
* the output will be clean for any error messages we have to emit.
*/
if (*pzOopsPrefix == NUL)
generateBlock(pTF, pTF->aMacros, pTF->aMacros + pTF->macroCt);
else {
(void)ag_scm_out_push_new(SCM_UNDEFINED);
generateBlock(pTF, pTF->aMacros, pTF->aMacros + pTF->macroCt);
/*
* Read back in the spooled output. Make sure it starts with
* a content-type: prefix. If not, we supply our own HTML prefix.
*/
res = ag_scm_out_pop(SCM_BOOL_T);
pzRes = AG_SCM_CHARS(res);
/* 13: "content-type:" */
if (strneqvcmp(pzRes, DO_STDOUT_TPL_CONTENT, 13) != 0)
fputs(DO_STDOUT_TPL_CONTENT, stdout);
fwrite(pzRes, AG_SCM_STRLEN(res), (size_t)1, stdout);
}
fclose(stdout);
}
/*
* process a single scheme expression, yielding text that gets processed
* into AutoGen definitions.
*/
static void
alist_to_autogen_def(void)
{
static char const zSchemeText[] = "Scheme Computed Definitions";
static char const zWrap[] = "(alist->autogen-def %s)";
char* pzText = ++(pCurCtx->pzScan);
char* pzEnd = (char*)skipScheme(pzText, pzText + strlen(pzText));
SCM res;
size_t res_len;
tScanCtx* pCtx;
/*
* Wrap the scheme expression with the `alist->autogen-def' function
*/
{
char endCh = *pzEnd;
*pzEnd = NUL;
pzText = aprf(zWrap, pzText);
*pzEnd = endCh;
}
/*
* Run the scheme expression. The result is autogen definition text.
*/
procState = PROC_STATE_GUILE_PRELOAD;
res = ag_scm_c_eval_string_from_file_line(
pzText, pCurCtx->pzCtxFname, pCurCtx->lineNo );
/*
* The result *must* be a string, or we choke.
*/
if (! AG_SCM_STRING_P(res)) {
static char const zEr[] =
"Scheme definition expression does not yield string:\n";
AG_ABEND(zEr);
}
res_len = AG_SCM_STRLEN(res);
procState = PROC_STATE_LOAD_DEFS;
pCurCtx->pzScan = pzEnd;
AGFREE(pzText);
/*
* Now, push the resulting string onto the input stack
* and link the new scan data into the context stack
*/
pCtx = (tScanCtx*)AGALOC(sizeof(tScanCtx) + 4 + res_len, "lex scan ctx");
pCtx->pCtx = pCurCtx;
pCurCtx = pCtx;
/*
* Set up the rest of the context structure
*/
AGDUPSTR(pCtx->pzCtxFname, zSchemeText, "scheme text");
pCtx->pzScan = \
pCtx->pzData = (char*)(pCtx+1);
pCtx->lineNo = 0;
memcpy((void*)(pCtx->pzScan), (void*)AG_SCM_CHARS(res), res_len);
pCtx->pzScan[ res_len ] = NUL;
/*
* At this point, the next token will be obtained
* from the newly allocated context structure.
* When empty, input will resume from the '}' that we
* left as the next input token in the old context.
*/
}
/*=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 = scm_ilength(list);
if (l_len == 0)
return AG_SCM_STR02SCM(zNil);
pzSep = AG_SCM_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 = ag_scribble(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((void*)pzScan, AG_SCM_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((void*)pzScan, (void*)pzSep, sep_len);
pzScan += sep_len;
}
return AG_SCM_STR2SCM(pzRes, str_len);
}
