/*=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); }