28 |
|
|
29 |
#ifdef WITH_GUILE |
#ifdef WITH_GUILE |
30 |
|
|
|
static struct list *process_head, *process_tail; |
|
|
static struct list *postprocess_head, *postprocess_tail; |
|
|
|
|
31 |
static void guile_ports_open(); |
static void guile_ports_open(); |
32 |
static void guile_ports_close(); |
static void guile_ports_close(); |
33 |
|
|
140 |
longjmp(*(jmp_buf*)data, 1); |
longjmp(*(jmp_buf*)data, 1); |
141 |
} |
} |
142 |
|
|
|
void |
|
|
guile_rewrite_line(char *procname, const char *source_line) |
|
|
{ |
|
|
SCM arg; |
|
|
SCM procsym; |
|
|
jmp_buf jmp_env; |
|
|
SCM res; |
|
|
char str[LINEBUFFER+1]; |
|
|
|
|
|
/* Prepare the argument */ |
|
|
if (source_line) { |
|
|
strncpy(str, source_line, LINEBUFFER); |
|
|
remcrlf(str); |
|
|
arg = scm_makfrom0str(str); |
|
|
} else |
|
|
arg = SCM_BOOL_F; |
|
|
|
|
|
/* Evaluate the procedure */ |
|
|
procsym = SCM_VARIABLE_REF(scm_c_lookup(procname)); |
|
|
if (scm_procedure_p(procsym) != SCM_BOOL_T) { |
|
|
anubis_error(SOFT, |
|
|
_("%s not a procedure object"), procname); |
|
|
return; |
|
|
} |
|
|
|
|
|
guile_ports_open(); |
|
|
if (setjmp(jmp_env)) { |
|
|
guile_ports_close(); |
|
|
return; |
|
|
} |
|
|
|
|
|
res = scm_internal_lazy_catch( |
|
|
SCM_BOOL_T, |
|
|
eval_catch_body, |
|
|
(void*) SCM_LIST2(procsym, |
|
|
scm_listify(scm_copy_tree(SCM_IM_QUOTE), |
|
|
arg, |
|
|
SCM_UNDEFINED)), |
|
|
eval_catch_handler, &jmp_env); |
|
|
|
|
|
if (SCM_IMP(res) && SCM_BOOLP(res)) { |
|
|
if (res == SCM_BOOL_F) { |
|
|
message.remlist_tail = new_element( |
|
|
message.remlist_tail, |
|
|
&message.remlist, str); |
|
|
} |
|
|
} else if (SCM_NIMP(res) && SCM_STRINGP(res)) { |
|
|
char *new_str = strdup (SCM_STRING_CHARS(res)); |
|
|
message.modlist_tail = new_element(message.modlist_tail, |
|
|
&message.modlist, |
|
|
str); |
|
|
message.modlist_tail->modify = new_str; |
|
|
} else if (SCM_NIMP(res) && SCM_CONSP(res)) { |
|
|
SCM car = SCM_CAR(res); |
|
|
SCM cdr = SCM_CDR(res); |
|
|
int n; |
|
|
|
|
|
if (car == SCM_BOOL_F) { |
|
|
message.remlist_tail = |
|
|
new_element(message.remlist_tail, |
|
|
&message.remlist, str); |
|
|
} else { |
|
|
char *new_str = strdup (SCM_STRING_CHARS(car)); |
|
|
message.modlist_tail = |
|
|
new_element(message.modlist_tail, |
|
|
&message.modlist, |
|
|
str); |
|
|
message.modlist_tail->modify = new_str; |
|
|
} |
|
|
|
|
|
|
|
|
for (n = 2; cdr != SCM_EOL; cdr = SCM_CDR(cdr), n++) { |
|
|
SCM cell = SCM_CAR(cdr); |
|
|
if (!(SCM_NIMP(cell) && SCM_STRINGP(cell))) { |
|
|
anubis_error(SOFT, |
|
|
_("Bad return type in element %d from %s."), |
|
|
n, procname); |
|
|
} else { |
|
|
char *new_str = strdup(SCM_STRING_CHARS(cell)); |
|
|
message.addlist_tail = |
|
|
new_element(message.addlist_tail, |
|
|
&message.addlist, |
|
|
new_str); |
|
|
} |
|
|
} |
|
|
} else |
|
|
anubis_error(SOFT, |
|
|
_("Bad return type from %s"), |
|
|
procname); |
|
|
guile_ports_close(); |
|
|
} |
|
143 |
|
|
144 |
static struct list * |
static struct list * |
145 |
guile_to_anubis(SCM cell) |
guile_to_anubis(SCM cell) |
146 |
{ |
{ |
147 |
static struct list *head = NULL, *tail = NULL; |
static struct list *list; |
148 |
|
|
149 |
|
list = list_create(); |
150 |
for (; cell != SCM_EOL; cell = SCM_CDR(cell)) { |
for (; cell != SCM_EOL; cell = SCM_CDR(cell)) { |
151 |
SCM car = SCM_CAR(cell); |
SCM car = SCM_CAR(cell); |
152 |
if (SCM_NIMP(car) && SCM_CONSP(car)) { |
if (SCM_NIMP(car) && SCM_CONSP(car)) { |
153 |
char *name; |
ASSOC *asc = xmalloc(sizeof(*asc)); |
|
char *value; |
|
|
char *line; |
|
154 |
|
|
155 |
name = SCM_STRING_CHARS(SCM_CAR(car)); |
asc->key = SCM_STRING_CHARS(SCM_CAR(car)); |
156 |
value = SCM_STRING_CHARS(SCM_CDR(car)); |
asc->value = SCM_STRING_CHARS(SCM_CDR(car)); |
157 |
line = xmalloc(strlen(name) + 2 + strlen(value) + 3); |
list_append(list, asc); |
|
sprintf(line, "%s: %s\r\n", name, value); |
|
|
tail = new_element(tail, &head, line); |
|
|
xfree(line); |
|
158 |
} |
} |
159 |
} |
} |
160 |
return head; |
return list; |
161 |
} |
} |
162 |
|
|
163 |
static SCM |
static SCM |
164 |
anubis_to_guile(struct list *p) |
anubis_to_guile(struct list *list) |
165 |
{ |
{ |
166 |
|
ASSOC *asc; |
167 |
SCM head = SCM_EOL, |
SCM head = SCM_EOL, |
168 |
tail; /* Don't let gcc fool you: tail cannot be used |
tail; /* Don't let gcc fool you: tail cannot be used |
169 |
uninitialized */ |
uninitialized */ |
170 |
|
|
171 |
for (; p; p = p->next) { |
for (asc = list_first(list); asc; asc = list_next(list)) { |
172 |
SCM cell, car, cdr; |
SCM cell, car, cdr; |
|
char *cp; |
|
173 |
|
|
174 |
cp = strchr(p->line, ':'); |
if (asc->key) |
175 |
if (!cp) |
car = scm_makfrom0str(asc->key); |
176 |
continue; |
else |
177 |
*cp = 0; |
car = SCM_BOOL_F; |
178 |
car = scm_makfrom0str(p->line); |
|
179 |
*cp = ':'; |
cdr = scm_makfrom0str(asc->value); |
|
|
|
|
for (cp++; *cp && isspace(*cp); cp++) |
|
|
; |
|
|
remcrlf(cp); |
|
|
cdr = scm_makfrom0str(cp); |
|
|
strcat(cp, CRLF); |
|
180 |
|
|
181 |
SCM_NEWCELL(cell); |
SCM_NEWCELL(cell); |
182 |
|
|
194 |
|
|
195 |
/* (define (postproc header-list body)*/ |
/* (define (postproc header-list body)*/ |
196 |
void |
void |
197 |
guile_process_proc(char *procname, struct list **hdr, char **body) |
guile_process_proc(char *procname, MESSAGE *msg) |
198 |
{ |
{ |
199 |
SCM arg_hdr, arg_body; |
SCM arg_hdr, arg_body; |
200 |
SCM procsym; |
SCM procsym; |
202 |
SCM res; |
SCM res; |
203 |
|
|
204 |
/* Prepare the arguments */ |
/* Prepare the arguments */ |
205 |
arg_hdr = anubis_to_guile(*hdr); |
arg_hdr = anubis_to_guile(msg->header); |
206 |
arg_body = scm_makfrom0str(*body); |
arg_body = scm_makfrom0str(msg->body); |
207 |
|
|
208 |
/* Evaluate the procedure */ |
/* Evaluate the procedure */ |
209 |
procsym = SCM_VARIABLE_REF(scm_c_lookup(procname)); |
procsym = SCM_VARIABLE_REF(scm_c_lookup(procname)); |
241 |
/* Preserve the headers */; |
/* Preserve the headers */; |
242 |
} else if (SCM_NIMP(ret_hdr) && SCM_CONSP(ret_hdr)) { |
} else if (SCM_NIMP(ret_hdr) && SCM_CONSP(ret_hdr)) { |
243 |
/* Replace them */ |
/* Replace them */ |
244 |
destroy_list(hdr); |
destroy_assoc_list(msg->header); |
245 |
*hdr = guile_to_anubis(ret_hdr); |
msg->header = guile_to_anubis(ret_hdr); |
246 |
} else |
} else |
247 |
anubis_error(SOFT, |
anubis_error(SOFT, |
248 |
_("Bad car type in return from %s"), |
_("Bad car type in return from %s"), |
252 |
/* Preserve the body as is */; |
/* Preserve the body as is */; |
253 |
} else if (ret_body == SCM_BOOL_F) { |
} else if (ret_body == SCM_BOOL_F) { |
254 |
/* Delete it */ |
/* Delete it */ |
255 |
free(*body); |
free(msg->body); |
256 |
*body = strdup(""); |
msg->body = strdup(""); |
257 |
} else if (SCM_NIMP(ret_body) && SCM_STRINGP(ret_body)) { |
} else if (SCM_NIMP(ret_body) && SCM_STRINGP(ret_body)) { |
258 |
/* Replace with the given string */ |
/* Replace with the given string */ |
259 |
xfree(*body); |
xfree(msg->body); |
260 |
*body = strdup(SCM_STRING_CHARS(ret_body)); |
msg->body = strdup(SCM_STRING_CHARS(ret_body)); |
261 |
} else |
} else |
262 |
anubis_error(SOFT, |
anubis_error(SOFT, |
263 |
_("Bad cdr type in return from %s"), |
_("Bad cdr type in return from %s"), |
269 |
guile_ports_close(); |
guile_ports_close(); |
270 |
} |
} |
271 |
|
|
|
void |
|
|
guile_process_list(struct list **hdr, char **body) |
|
|
{ |
|
|
struct list *p; |
|
|
|
|
|
for (p = process_head; p; p = p->next) |
|
|
guile_process_proc(p->line, hdr, body); |
|
|
} |
|
|
|
|
|
void |
|
|
guile_postprocess_list(struct list **hdr, char **body) |
|
|
{ |
|
|
struct list *p; |
|
|
|
|
|
for (p = postprocess_head; p; p = p->next) |
|
|
guile_process_proc(p->line, hdr, body); |
|
|
} |
|
|
|
|
|
int |
|
|
guile_proclist_empty() |
|
|
{ |
|
|
return process_head == NULL; |
|
|
} |
|
|
|
|
272 |
/* RC file stuff */ |
/* RC file stuff */ |
273 |
|
|
274 |
#define KW_GUILE_OUTPUT 0 |
#define KW_GUILE_OUTPUT 0 |
285 |
{ "guile-debug", KW_GUILE_DEBUG }, |
{ "guile-debug", KW_GUILE_DEBUG }, |
286 |
{ "guile-load-path-append", KW_GUILE_LOAD_PATH_APPEND }, |
{ "guile-load-path-append", KW_GUILE_LOAD_PATH_APPEND }, |
287 |
{ "guile-load-program", KW_GUILE_LOAD_PROGRAM }, |
{ "guile-load-program", KW_GUILE_LOAD_PROGRAM }, |
|
{ "guile-process", KW_GUILE_PROCESS }, |
|
|
{ "guile-postprocess", KW_GUILE_POSTPROCESS }, |
|
288 |
{ NULL } |
{ NULL } |
289 |
}; |
}; |
290 |
|
|
294 |
{ "guile-load-program", KW_GUILE_LOAD_PROGRAM }, |
{ "guile-load-program", KW_GUILE_LOAD_PROGRAM }, |
295 |
{ "guile-rewrite-line", KW_GUILE_REWRITE_LINE }, |
{ "guile-rewrite-line", KW_GUILE_REWRITE_LINE }, |
296 |
{ "guile-process", KW_GUILE_PROCESS }, |
{ "guile-process", KW_GUILE_PROCESS }, |
|
{ "guile-postprocess", KW_GUILE_POSTPROCESS }, |
|
297 |
{ NULL } |
{ NULL } |
298 |
}; |
}; |
299 |
|
|
300 |
int |
int |
301 |
guile_parser(int method, int key, char *arg, |
guile_parser(int method, int key, char *arg, void *inv_data, void *func_data, |
302 |
void *inv_data, void *func_data, char *line) |
MESSAGE *msg) |
303 |
{ |
{ |
304 |
switch (key) { |
switch (key) { |
305 |
case KW_GUILE_OUTPUT: |
case KW_GUILE_OUTPUT: |
320 |
break; |
break; |
321 |
|
|
322 |
case KW_GUILE_PROCESS: |
case KW_GUILE_PROCESS: |
323 |
process_tail = new_element(process_tail, |
guile_process_proc(arg, msg); |
|
&process_head, |
|
|
strdup(arg)); |
|
|
break; |
|
|
|
|
|
case KW_GUILE_POSTPROCESS: |
|
|
postprocess_tail = new_element(postprocess_tail, |
|
|
&postprocess_head, |
|
|
strdup(arg)); |
|
324 |
break; |
break; |
325 |
|
|
326 |
case KW_GUILE_REWRITE_LINE: |
case KW_GUILE_REWRITE_LINE: |
327 |
guile_rewrite_line(arg, line); |
/*FIXME*/ |
328 |
|
/*guile_rewrite_line(arg, line);*/ |
329 |
break; |
break; |
330 |
|
|
331 |
default: |
default: |