on-error parameter of progn function.

diff --git a/modules/ml-struct.cc b/modules/ml-struct.cc
index b0eaa47..17b3e7e 100644 (file)
--- a/modules/ml-struct.cc
+++ b/modules/ml-struct.cc
@@ -149,8 +149,31 @@ MNode*  ml_cond (MNode* cell, MlEnv* mlenv) {
 MNode*  ml_progn (MNode* cell, MlEnv* mlenv) {
     MNode*  arg = cell->cdr ();
     MNodePtr  ans;
+    MNodePtr  errfn;
+    std::vector<MNode*>  keywords;
+    MNode*  rest;
+    static paramList  kwlist[] = {
+       {CharConst ("on-error"), false},
+       {NULL, 0, 0}
+    };
 
-    ans =  progn (arg, mlenv);
+    setParams (arg, 0, NULL, kwlist, &keywords, &rest);
+    if (keywords[0])
+       errfn = eval (keywords[0], mlenv);
+
+    try {
+       ans =  progn (rest, mlenv);
+    } catch (ustring& msg) {
+       if (errfn ()) {
+           MNodePtr  v;
+           MNodePtr  ag;
+           ag = new MNode;
+           ag ()->set_car (mlenv->currentCell ());
+           v = execDefun (mlenv, errfn (), ag (), uEmpty);
+       } else {
+           throw (msg);
+       }
+    }
     if (mlenv->breaksym ()
        && (mlenv->breaksym ()->isNil () || eq (mlenv->breaksym (), cell->car ()))) {
        mlenv->setBreaksym (NULL);