static SCM
shell_stringify(SCM obj, uint_t qt)
{
char * pzNew;
size_t dtaSize = 3;
char * pzDta = ag_scm2zchars(obj, "AG Object");
char * pz = pzDta;
for (;;) {
char c = *(pz++);
switch (c) {
case NUL:
goto loopDone1;
case '"': case '`': case '\\':
dtaSize += 2;
break;
default:
dtaSize++;
}
} loopDone1:;
pzNew = AGALOC(dtaSize, "shell string");
dtaSize = stringify_for_sh(pzNew, qt, pzDta);
{
SCM res = AG_SCM_STR2SCM(pzNew, dtaSize);
AGFREE(pzNew);
return res;
}
}
/*=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(scm_i_string_chars(Str), lenz);
return ag_scm_string_tr_x(res, From, To);
}
/*=gfunc prefix
*
* what: prefix lines with a string
* general_use:
*
* exparg: prefix, string to insert at start of each line
* exparg: text, multi-line block of text
*
* doc:
* Prefix every line in the second string with the first string.
*
* For example, if the first string is "# " and the second contains:
* @example
* two
* lines
* @end example
* @noindent
* The result string will contain:
* @example
* # two
* # lines
* @end example
=*/
SCM
ag_scm_prefix(SCM prefix, SCM text)
{
char* pzPfx;
char* pzText;
char* pzDta;
size_t out_size, rem_size;
size_t pfx_size;
char* pzRes;
pzPfx = ag_scm2zchars(prefix, "prefix");
pzDta = \
pzText = ag_scm2zchars(text, "text");
pfx_size = strlen(pzPfx);
out_size = pfx_size;
for (;;) {
switch (*(pzText++)) {
case NUL:
goto exit_count;
case NL:
out_size += pfx_size;
/* FALLTHROUGH */
default:
out_size++;
}
} exit_count:;
pzText = pzDta;
pzRes = pzDta = ag_scribble(rem_size = out_size);
strcpy(pzDta, pzPfx);
pzDta += pfx_size;
rem_size -= pfx_size;
pfx_size++;
for (;;) {
char ch = *(pzText++);
switch (ch) {
case NUL:
if (rem_size != 0)
AG_ABEND(PREFIX_FAIL);
return AG_SCM_STR2SCM(pzRes, out_size);
case NL:
*pzDta = ch;
strcpy(pzDta+1, pzPfx);
pzDta += pfx_size;
rem_size -= pfx_size;
break;
default:
rem_size--;
*(pzDta++) = ch;
break;
}
}
}
/*=gfunc prefix
*
* what: prefix lines with a string
* general_use:
*
* exparg: prefix, string to insert at start of each line
* exparg: text, multi-line block of text
*
* doc:
* Prefix every line in the second string with the first string.
* This includes empty lines, though trailing white space will
* be removed if the line consists only of the "prefix".
* Also, if the last character is a newline, then *two* prefixes will
* be inserted into the result text.
*
* For example, if the first string is "# " and the second contains:
* @example
* "two\nlines\n"
* @end example
* @noindent
* The result string will contain:
* @example
* # two
* # lines
* #
* @end example
*
* The last line will be incomplete: no newline and no space after the
* hash character, either.
=*/
SCM
ag_scm_prefix(SCM prefx, SCM txt)
{
char * prefix = ag_scm2zchars(prefx, "pfx");
char * text = ag_scm2zchars(txt, "txt");
char * scan = text;
size_t pfx_size = strlen(prefix);
char * r_str; /* result string */
{
size_t out_size = pfx_size + 1; // NUL or NL byte adjustment
for (;;) {
switch (*(scan++)) {
case NUL:
out_size += scan - text;
goto exit_count;
case NL:
out_size += pfx_size;
}
} exit_count:;
r_str = scan = scribble_get((ssize_t)out_size);
}
memcpy(scan, prefix, pfx_size);
scan += pfx_size;
pfx_size++;
for (;;) {
char ch = *(text++);
switch (ch) {
case NUL:
/*
* Trim trailing white space on the final line.
*/
scan = SPN_HORIZ_WHITE_BACK(r_str, scan);
return AG_SCM_STR2SCM(r_str, scan - r_str);
case NL:
/*
* Trim trailing white space on previous line first.
*/
scan = SPN_HORIZ_WHITE_BACK(r_str, scan);
*scan = NL;
memcpy(scan+1, prefix, pfx_size - 1);
scan += pfx_size; // prefix length plus 1 for new line
break;
default:
*(scan++) = ch;
break;
}
}
}
/*
* If we got it, emit it.
*/
static SCM
get_text(char const* pzText, char const* pzStart, char const* pzEnd, SCM def)
{
char const* pzS = strstr(pzText, pzStart);
char const* pzE;
if (pzS == NULL)
return mk_empty_text(pzStart, pzEnd, def);
pzE = strstr(pzS, pzEnd);
if (pzE == NULL)
return mk_empty_text(pzStart, pzEnd, def);
pzE += strlen(pzEnd);
return AG_SCM_STR2SCM(pzS, (size_t)(pzE - pzS));
}
/*=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 * text;
ssize_t len;
SCM res;
if (! AG_SCM_STRING_P(str))
return SCM_UNDEFINED;
text = scm_i_string_chars(str);
len = (ssize_t)AG_SCM_STRLEN(str);
if (AG_SCM_STRING_P(Match))
do_substitution(text, len, Match, Repl, (char **)&text, &len);
else
do_multi_subs((char **)&text, &len, Match, Repl);
res = AG_SCM_STR2SCM(text, (size_t)len);
return res;
}
/*=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;
}
/*=gfunc hide_email
*
* what: convert eaddr to javascript
* general_use:
*
* exparg: display, display text
* exparg: eaddr, email address
*
* doc: Hides an email address as a java scriptlett.
* The 'mailto:' tag and the email address are coded bytes
* rather than plain text. They are also broken up.
=*/
SCM
ag_scm_hide_email(SCM display, SCM eaddr)
{
static char const zFmt[] = "&#%d;";
static char const zStrt[] =
"<script language=\"JavaScript\" type=\"text/javascript\">\n"
"<!--\n"
"var one = 'ma';\n"
"var two = 'ilt';\n"
"document.write('<a href=\"' + one + two );\n"
"document.write('o:";
static char const zEnd[] = "');\n"
"document.write('\" >%s</a>');\n"
"//-->\n</script>";
char* pzDisp = ag_scm2zchars(display, zFormat);
char* pzEadr = ag_scm2zchars(eaddr, zFormat);
size_t str_size = (strlen(pzEadr) * sizeof(zFmt))
+ sizeof(zStrt) + sizeof(zEnd) + strlen(pzDisp);
char* pzRes = ag_scribble(str_size);
char* pzScan = pzRes;
strcpy(pzScan, zStrt);
pzScan += sizeof(zStrt) - 1;
for (;;) {
if (*pzEadr == NUL)
break;
pzScan += sprintf(pzScan, zFmt, *(pzEadr++));
}
pzScan += sprintf(pzScan, zEnd, pzDisp);
return AG_SCM_STR2SCM(pzRes, (size_t)(pzScan - pzRes));
}
LOCAL SCM
run_printf(char const * pzFmt, int len, SCM alist)
{
SCM res;
void* args[8];
void** arglist;
void** argp;
if (len < 8)
arglist = argp = args;
else
arglist =
argp = (void**)malloc((len+1) * sizeof(void*));
while (len-- > 0) {
SCM car = SCM_CAR(alist);
alist = SCM_CDR(alist);
switch (ag_scm_type_e(car)) {
default:
case GH_TYPE_UNDEFINED:
*(argp++) = (char*)"???";
break;
case GH_TYPE_BOOLEAN:
*(argp++) = (void*)((car == SCM_BOOL_F) ? "#f" : "#t");
break;
case GH_TYPE_CHAR:
*(char*)(argp++) = AG_SCM_CHAR(car);
break;
case GH_TYPE_PAIR:
*(argp++) = (char*)"..";
break;
case GH_TYPE_NUMBER:
*(unsigned long*)(argp++) = AG_SCM_TO_ULONG(car);
break;
case GH_TYPE_SYMBOL:
case GH_TYPE_STRING:
*(argp++) = ag_scm2zchars(car, "printf str");
break;
case GH_TYPE_PROCEDURE:
*(argp++) = (char*)"(*)()";
break;
case GH_TYPE_VECTOR:
case GH_TYPE_LIST:
*(argp++) = (char*)"...";
break;
}
}
/*
* Do the formatting and allocate a new SCM to hold the result.
* Free up any allocations made by ``gh_scm2newstr''
*/
{
char* pzBuf;
size_t bfSize = safePrintf(&pzBuf, pzFmt, arglist);
res = AG_SCM_STR2SCM(pzBuf, bfSize);
free(pzBuf);
}
if (arglist != args)
AGFREE((void*)arglist);
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);
}
