/[anubis]/anubis/src/guile.c
ViewVC logotype

Diff of /anubis/src/guile.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by gray, Tue Feb 11 16:51:45 2003 UTC revision 1.7 by gray, Wed Feb 26 16:53:08 2003 UTC
# Line 28  Line 28 
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    
# Line 143  eval_catch_handler(void *data, SCM tag, Line 140  eval_catch_handler(void *data, SCM tag,
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                                    
# Line 298  anubis_to_guile(struct list *p) Line 194  anubis_to_guile(struct list *p)
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;
# Line 306  guile_process_proc(char *procname, struc Line 202  guile_process_proc(char *procname, struc
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));
# Line 345  guile_process_proc(char *procname, struc Line 241  guile_process_proc(char *procname, struc
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"),
# Line 356  guile_process_proc(char *procname, struc Line 252  guile_process_proc(char *procname, struc
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"),
# Line 373  guile_process_proc(char *procname, struc Line 269  guile_process_proc(char *procname, struc
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
# Line 413  static struct rc_kwdef guile_kw[] = { Line 285  static struct rc_kwdef guile_kw[] = {
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    
# Line 424  static struct rc_kwdef guile_rule_kw[] = Line 294  static struct rc_kwdef guile_rule_kw[] =
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:
# Line 451  guile_parser(int method, int key, char * Line 320  guile_parser(int method, int key, char *
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:

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26