Back to index

texmacs  1.0.7.15
env_exec.cpp
Go to the documentation of this file.
00001 
00002 /******************************************************************************
00003 * MODULE     : env_exec.cpp
00004 * DESCRIPTION: evaluation of trees w.r.t. the environment
00005 * COPYRIGHT  : (C) 1999  Joris van der Hoeven
00006 *******************************************************************************
00007 * This software falls under the GNU general public license version 3 or later.
00008 * It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
00009 * in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
00010 ******************************************************************************/
00011 
00012 #include "env.hpp"
00013 #include "convert.hpp"
00014 #include "file.hpp"
00015 #include "image_files.hpp"
00016 #include "scheme.hpp"
00017 #include "page_type.hpp"
00018 #include "typesetter.hpp"
00019 #include "drd_mode.hpp"
00020 #include "dictionary.hpp"
00021 
00022 extern int script_status;
00023 
00024 /******************************************************************************
00025 * Subroutines
00026 ******************************************************************************/
00027 
00028 string
00029 edit_env_rep::exec_string (tree t) {
00030   tree r= exec (t);
00031   if (is_atomic (r)) return r->label;
00032   else return "";
00033 }
00034 
00035 /******************************************************************************
00036 * Rewriting (scheme-like macro expansion)
00037 ******************************************************************************/
00038 
00039 // Hack to transmit the current environment back to C++
00040 // across the Scheme level, and to maintain reentrancy.
00041 static edit_env current_rewrite_env= edit_env ();
00042 
00043 tree
00044 edit_env_rep::rewrite (tree t) {
00045   switch (L(t)) {
00046   case EXTERN:
00047     {
00048       int i, n= N(t);
00049       if (n == 0) return tree (ERROR, "invalid extern");
00050       tree r (TUPLE, n);
00051       for (i=0; i<n; i++)
00052        r[i]= exec (t[i]);
00053       object expr= null_object ();
00054       for (i=n-1; i>0; i--)
00055        expr= cons (object (r[i]), expr);
00056       if (N(t) < 1) return tree (ERROR, "invalid extern");
00057       string fun= exec_string (t[0]);
00058       expr= cons (string_to_object (fun), expr);
00059       if (!secure && script_status < 2) {
00060        if (!as_bool (call ("secure?", expr)))
00061          return tree (ERROR, "insecure script");
00062       }
00063       edit_env old_env= current_rewrite_env;
00064       current_rewrite_env= edit_env (this);
00065       object o= eval (expr);
00066       current_rewrite_env= old_env;
00067       return content_to_tree (o);
00068     }
00069   case MAP_ARGS:
00070     {
00071       if (N(t) < 3 ||
00072          !(is_atomic (t[0]) && is_atomic (t[1]) && is_atomic (t[2])))
00073        return tree (ERROR, "invalid map arguments");
00074       if (is_nil (macro_arg) || (!macro_arg->item->contains (t[2]->label)))
00075        return tree (ERROR, "map arguments " * t[2]->label);
00076       tree v= macro_arg->item [t[2]->label];
00077       if (is_atomic (v))
00078        return tree (ERROR, "map arguments " * t[2]->label);
00079       list<hashmap<string,tree> > old_var= macro_arg;
00080       list<hashmap<string,path> > old_src= macro_src;
00081       if (!is_nil (macro_arg)) macro_arg= macro_arg->next;
00082       if (!is_nil (macro_src)) macro_src= macro_src->next;
00083 
00084       int start= 0, end= N(v);
00085       if (N(t)>=4) start= as_int (exec (t[3]));
00086       if (N(t)>=5) end  = as_int (exec (t[4]));
00087       int i, n= max (0, end-start);
00088       tree r (make_tree_label (t[1]->label), n);
00089       for (i=0; i<n; i++)
00090        r[i]= tree (make_tree_label (t[0]->label),
00091                   tree (ARG, copy (t[2]), as_string (start+i)),
00092                   as_string (start+i));
00093 
00094       macro_arg= old_var;
00095       macro_src= old_src;
00096       return r;
00097     }
00098   case INCLUDE:
00099     {
00100       if (N(t) == 0) return tree (ERROR, "invalid include");
00101       url file_name= url_system (exec_string (t[0]));
00102       return load_inclusion (relative (base_file_name, file_name));
00103     }
00104   case REWRITE_INACTIVE:
00105     {
00106       if (N(t) == 0 || N(t[0]) == 0)
00107        return tree (ERROR, "invalid rewrite-inactive");
00108       if ((!is_func (t[0], ARG)) ||
00109          is_compound (t[0][0]) ||
00110          is_nil (macro_arg) ||
00111          (!macro_arg->item->contains (t[0][0]->label)))
00112        return tree (ERROR, "invalid rewrite-inactive");
00113       tree val= macro_arg->item [t[0][0]->label];
00114       int i, n= N(t[0]);
00115       for (i=1; i<n; i++) {
00116        int j= as_int (t[0][i]);
00117        if ((j>=0) && (j<N(val))) val= val[j];
00118        else return tree (ERROR, "invalid rewrite-inactive");
00119       }
00120       if (N(t) < 2)
00121        return tree (ERROR, "invalid rewrite-inactive");
00122       if (t[1] == "recurse") inactive_mode= INACTIVE_INLINE_RECURSE;
00123       else if (t[1] == "recurse*") inactive_mode= INACTIVE_BLOCK_RECURSE;
00124       else if (t[1] == "once") inactive_mode= INACTIVE_INLINE_ONCE;
00125       else if (t[1] == "once*") inactive_mode= INACTIVE_BLOCK_ONCE;
00126       else if (t[1] == "error") inactive_mode= INACTIVE_INLINE_ERROR;
00127       else if (t[1] == "error*") inactive_mode= INACTIVE_BLOCK_ERROR;
00128       else inactive_mode= INACTIVE_INLINE_RECURSE;
00129       return rewrite_inactive (val, t[0]);
00130     }
00131   default:
00132     return t;
00133   }
00134 }
00135 
00136 tree
00137 edit_env_rep::exec_rewrite (tree t) {
00138   /*
00139   cout << "t= " << t << "\n";
00140   tree r= rewrite (t);
00141   r= exec (r);
00142   cout << "r= " << r << "\n";
00143   return r;
00144   */
00145   return exec (rewrite (t));
00146 }
00147 
00148 bool
00149 edit_env_rep::exec_until_rewrite (tree t, path p, string var, int level) {
00150   /*
00151   cout << "Execute " << t << " (" << var << ", "
00152        << level << ") until " << p << "\n"
00153        << "  -> " << rewrite (t) << "\n";
00154   */
00155   return exec_until (rewrite (t), p, var, level);
00156 }
00157 
00158 tree
00159 texmacs_exec (edit_env env, tree cmd) {
00160   // re-entrancy
00161   if (!is_nil (current_rewrite_env)) env= current_rewrite_env;
00162   return env->exec (cmd);
00163 }
00164 
00165 /******************************************************************************
00166 * Evaluation of trees
00167 ******************************************************************************/
00168 
00169 tree
00170 edit_env_rep::exec (tree t) {
00171   // cout << "Execute: " << t << "\n";
00172   if (is_atomic (t)) return t;
00173   switch (L(t)) {
00174   case DATOMS:
00175     return exec_formatting (t, ATOM_DECORATIONS);
00176   case DLINES:
00177     return exec_formatting (t, LINE_DECORATIONS);
00178   case DPAGES:
00179     return exec_formatting (t, PAGE_DECORATIONS);
00180   case TFORMAT:
00181     return exec_formatting (t, CELL_FORMAT);
00182   case TABLE:
00183     return exec_table (t);
00184   case ASSIGN:
00185     return exec_assign (t);
00186   case WITH:
00187     return exec_with (t);
00188   case PROVIDES:
00189     return exec_provides (t);
00190   case VALUE:
00191     return exec_value (t);
00192   case QUOTE_VALUE:
00193     return exec_quote_value (t);
00194   case MACRO:
00195     return copy (t);
00196   case DRD_PROPS:
00197     return exec_drd_props (t);
00198   case ARG:
00199     return exec_arg (t);
00200   case QUOTE_ARG:
00201     return exec_quote_arg (t);
00202   case COMPOUND:
00203     return exec_compound (t);
00204   case XMACRO:
00205     return copy (t);
00206   case GET_LABEL:
00207     return exec_get_label (t);
00208   case GET_ARITY:
00209     return exec_get_arity (t);
00210   case MAP_ARGS:
00211     return exec_rewrite (t);
00212   case EVAL_ARGS:
00213     return exec_eval_args (t);
00214   case MARK:
00215     if (N(t) < 2)
00216       return tree (ERROR, "invalid mark");
00217     return tree (MARK, copy (t[0]), exec (t[1]));
00218   case EXPAND_AS:
00219     if (N(t) < 2)
00220       return tree (ERROR, "invalid expand-as");
00221     return exec (t[1]);
00222   case EVAL:
00223     if (N(t) < 1)
00224       return tree (ERROR, "invalid eval");
00225     return exec (exec (t[0]));
00226   case QUOTE:
00227     if (N(t) < 1)
00228       return tree (ERROR, "invalid quote");
00229     return t[0];
00230   case QUASI:
00231     if (N(t) < 1)
00232       return tree (ERROR, "invalid quasi");
00233     return exec (exec_quasiquoted (t[0]));
00234   case QUASIQUOTE:
00235     if (N(t) < 1)
00236       return tree (ERROR, "invalid quasiquote");
00237     return exec_quasiquoted (t[0]);
00238   case UNQUOTE:
00239     if (N(t) < 1)
00240       return tree (ERROR, "invalid unquote");
00241     return exec (t[0]);
00242   case VAR_UNQUOTE:
00243     if (N(t) < 1)
00244       return tree (ERROR, "invalid var-unquote");
00245     return exec (t[0]);
00246   case COPY:
00247     if (N(t) < 1)
00248       return tree (ERROR, "invalid copy");
00249     return copy (exec (t[0]));
00250   case IF:
00251   case VAR_IF:
00252     return exec_if (t);
00253   case CASE:
00254     return exec_case (t);
00255   case WHILE:
00256     return exec_while (t);
00257   case FOR_EACH:
00258     return exec_for_each (t);
00259   case EXTERN:
00260     return exec_rewrite (t);
00261   case INCLUDE:
00262     return exec_rewrite (t);
00263   case USE_PACKAGE:
00264     return exec_use_package (t);
00265   case USE_MODULE:
00266     return exec_use_module (t);
00267 
00268   case OR:
00269     return exec_or (t);
00270   case XOR:
00271     return exec_xor (t);
00272   case AND:
00273     return exec_and (t);
00274   case NOT:
00275     return exec_not (t);
00276   case PLUS:
00277   case MINUS:
00278     return exec_plus_minus (t);
00279   case TIMES:
00280   case OVER:
00281     return exec_times_over (t);
00282   case DIV:
00283     return exec_divide (t);
00284   case MOD:
00285     return exec_modulo (t);
00286   case MINIMUM:
00287   case MAXIMUM:
00288     return exec_min_max (t);
00289   case MATH_SQRT:
00290     return exec_math_sqrt (t);
00291   case EXP:
00292     return exec_exp (t);
00293   case LOG:
00294     return exec_log (t);
00295   case POW:
00296     return exec_pow (t);
00297   case COS:
00298     return exec_cos (t);
00299   case SIN:
00300     return exec_sin (t);
00301   case TAN:
00302     return exec_tan (t);
00303   case MERGE:
00304     return exec_merge (t);
00305   case LENGTH:
00306     return exec_length (t);
00307   case RANGE:
00308     return exec_range (t);
00309   case NUMBER:
00310     return exec_number (t);
00311   case _DATE:
00312     return exec_date (t);
00313   case TRANSLATE:
00314     return exec_translate (t);
00315   case CHANGE_CASE:
00316     return exec_change_case (t);
00317   case FIND_FILE:
00318     return exec_find_file (t);
00319   case IS_TUPLE:
00320     return exec_is_tuple (t);
00321   case LOOK_UP:
00322     return exec_lookup (t);
00323   case EQUAL:
00324     return exec_equal (t);
00325   case UNEQUAL:
00326     return exec_unequal (t);
00327   case LESS:
00328     return exec_less (t);
00329   case LESSEQ:
00330     return exec_lesseq (t);
00331   case GREATER:
00332     return exec_greater (t);
00333   case GREATEREQ:
00334     return exec_greatereq (t);
00335 
00336   case CM_LENGTH:
00337     return exec_cm_length ();
00338   case MM_LENGTH:
00339     return exec_mm_length ();
00340   case IN_LENGTH:
00341     return exec_in_length ();
00342   case PT_LENGTH:
00343     return exec_pt_length ();
00344   case BP_LENGTH:
00345     return exec_bp_length ();
00346   case DD_LENGTH:
00347     return exec_dd_length ();
00348   case PC_LENGTH:
00349     return exec_pc_length ();
00350   case CC_LENGTH:
00351     return exec_cc_length ();
00352   case FS_LENGTH:
00353     return exec_fs_length ();
00354   case FBS_LENGTH:
00355     return exec_fbs_length ();
00356   case EM_LENGTH:
00357     return exec_em_length ();
00358   case LN_LENGTH:
00359     return exec_ln_length ();
00360   case SEP_LENGTH:
00361     return exec_sep_length ();
00362   case YFRAC_LENGTH:
00363     return exec_yfrac_length ();
00364   case EX_LENGTH:
00365     return exec_ex_length ();
00366   case FN_LENGTH:
00367     return exec_fn_length ();
00368   case FNS_LENGTH:
00369     return exec_fns_length ();
00370   case BLS_LENGTH:
00371     return exec_bls_length ();
00372   case FNBOT_LENGTH:
00373     return exec_fnbot_length ();
00374   case FNTOP_LENGTH:
00375     return exec_fntop_length ();
00376   case SPC_LENGTH:
00377     return exec_spc_length ();
00378   case XSPC_LENGTH:
00379     return exec_xspc_length ();
00380   case PAR_LENGTH:
00381     return exec_par_length ();
00382   case PAG_LENGTH:
00383     return exec_pag_length ();
00384   case GW_LENGTH:
00385     return exec_gw_length ();
00386   case GH_LENGTH:
00387     return exec_gh_length ();
00388   case TMPT_LENGTH:
00389     return exec_tmpt_length ();
00390   case PX_LENGTH:
00391     return exec_px_length ();
00392   case MSEC_LENGTH:
00393     return exec_msec_length ();
00394   case SEC_LENGTH:
00395     return exec_sec_length ();
00396   case MIN_LENGTH:
00397     return exec_min_length ();
00398   case HR_LENGTH:
00399     return exec_hr_length ();
00400 
00401   case STYLE_WITH:
00402   case VAR_STYLE_WITH:
00403     if (N(t) < 1)
00404       return tree (ERROR, "invalid style-with");
00405     return exec (t[N(t)-1]);
00406   case STYLE_ONLY:
00407   case VAR_STYLE_ONLY:
00408   case ACTIVE:
00409   case VAR_ACTIVE:
00410   case INACTIVE:
00411   case VAR_INACTIVE:
00412     return exec_compound (t);
00413   case REWRITE_INACTIVE:
00414     return exec_rewrite (t);
00415 
00416   case HARD_ID:
00417     return exec_hard_id (t);
00418   case SCRIPT:
00419     return exec_script (t);
00420   case HLINK:
00421   case ACTION:
00422     return exec_compound (t);
00423   case SET_BINDING:
00424     return exec_set_binding (t);
00425   case GET_BINDING:
00426     return exec_get_binding (t);
00427 
00428   case PATTERN:
00429     return exec_pattern (t);
00430 
00431   case _POINT:
00432     return exec_point (t);
00433   case BOX_INFO:
00434     return exec_box_info (t);
00435   case FRAME_DIRECT:
00436     return exec_frame_direct (t);
00437   case FRAME_INVERSE:
00438     return exec_frame_inverse (t);
00439 
00440   default:
00441     if (L(t) < START_EXTENSIONS) {
00442       int i, n= N(t);
00443       // cout << "Executing " << t << "\n";
00444       tree r (t, n);
00445       for (i=0; i<n; i++) r[i]= exec (t[i]);
00446       // cout << "Executed " << t << " -> " << r << "\n";
00447       return r;
00448     }
00449     else return exec_compound (t);
00450   }
00451 }
00452 
00453 tree
00454 edit_env_rep::exec_formatting (tree t, string v) {
00455   int i, n= N(t);
00456   if (n < 1)
00457     return tree (ERROR, "bad formatting");
00458   tree r (t, n);
00459   for (i=0; i<n-1; i++) r[i]= exec (t[i]);
00460   tree oldv= read (v);
00461   tree newv= oldv * r (0, n-1);
00462   // monitored_write_update (v, newv);
00463   write_update (v, newv);
00464   r[n-1]= exec (t[n-1]);
00465   write_update (v, oldv);
00466   return r;
00467 }
00468 
00469 tree
00470 edit_env_rep::exec_table (tree t) {
00471   tree oldv= read (CELL_FORMAT);
00472   // should execute values in oldv
00473   // monitored_write_update (CELL_FORMAT, tree (TFORMAT));
00474   write_update (CELL_FORMAT, tree (TFORMAT));
00475   int i, n= N(t);
00476   tree r (t, n);
00477   for (i=0; i<n; i++) r[i]= exec (t[i]);
00478   write_update (CELL_FORMAT, oldv);
00479   return r;
00480 }
00481 
00482 tree
00483 edit_env_rep::exec_assign (tree t) {
00484   if (N(t)!=2) return tree (ERROR, "bad assign");
00485   tree r= exec (t[0]);
00486   if (is_compound (r)) return tree (ERROR, "bad assign");
00487   assign (r->label, copy (t[1]));
00488   return tree (ASSIGN, r, tree (QUOTE, read (r->label)));
00489 }
00490 
00491 tree
00492 edit_env_rep::exec_with (tree t) {
00493   int i, n= N(t), k= (n-1)>>1; // is k=0 allowed ?
00494   if ((n&1) != 1) return tree (ERROR, "bad with");
00495   STACK_NEW_ARRAY(vars,string,k);
00496   STACK_NEW_ARRAY(oldv,tree,k);
00497   STACK_NEW_ARRAY(newv,tree,k);
00498   for (i=0; i<k; i++) {
00499     tree var_t= exec (t[i<<1]);
00500     if (is_atomic (var_t)) {
00501       string var= var_t->label;
00502       vars[i]= var;
00503       oldv[i]= read (var);
00504       newv[i]= exec (t[(i<<1)+1]);
00505     }
00506     else {
00507       STACK_DELETE_ARRAY(vars);
00508       STACK_DELETE_ARRAY(oldv);
00509       STACK_DELETE_ARRAY(newv);
00510       return tree (ERROR, "bad with");
00511     }
00512   }
00513 
00514   // for (i=0; i<k; i++) monitored_write_update (vars[i], newv[i]);
00515   for (i=0; i<k; i++) write_update (vars[i], newv[i]);
00516   tree r= exec (t[n-1]);
00517   for (i=k-1; i>=0; i--) write_update (vars[i], oldv[i]);
00518 
00519   tree u (WITH, n);
00520   for (i=0; i<k; i++) {
00521     u[i<<1]    = vars[i];
00522     u[(i<<1)+1]= tree (QUOTE, newv[i]);
00523   }
00524   u[n-1]= r;
00525   STACK_DELETE_ARRAY(vars);
00526   STACK_DELETE_ARRAY(oldv);
00527   STACK_DELETE_ARRAY(newv);
00528   return u;
00529 }
00530 
00531 tree
00532 edit_env_rep::exec_compound (tree t) {
00533   int d; tree f;
00534   if (L(t) == COMPOUND) {
00535     if (N(t)<1) return tree (ERROR, "bad compound");
00536     d= 1;
00537     f= t[0];
00538     if (is_compound (f)) f= exec (f);
00539     if (is_atomic (f)) {
00540       string var= f->label;
00541       if (!provides (var)) return tree (ERROR, "compound " * var);
00542       f= read (var);
00543     }
00544   }
00545   else {
00546     string var= as_string (L(t));
00547     if (!provides (var)) return tree (ERROR, "compound " * var);
00548     d= 0;
00549     f= read (var);
00550   }
00551 
00552   if (is_applicable (f)) {
00553     int i, n=N(f)-1, m=N(t)-d;
00554     macro_arg= list<hashmap<string,tree> > (
00555       hashmap<string,tree> (UNINIT), macro_arg);
00556     macro_src= list<hashmap<string,path> > (
00557       hashmap<string,path> (path (DECORATION)), macro_src);
00558     if (L(f) == XMACRO) {
00559       if (is_atomic (f[0]))
00560        macro_arg->item (f[0]->label)= t;
00561     }
00562     else for (i=0; i<n; i++)
00563       if (is_atomic (f[i])) {
00564        tree st= i<m? t[i+d]: tree (UNINIT);
00565        macro_arg->item (f[i]->label)= st;
00566        macro_src->item (f[i]->label)= obtain_ip (st);
00567       }
00568     tree r= exec (f[n]);
00569     macro_arg= macro_arg->next;
00570     macro_src= macro_src->next;
00571     return r;
00572   }
00573   else return exec (f);
00574 }
00575 
00576 tree
00577 edit_env_rep::exec_drd_props (tree t) {
00578   int i, n= N(t);
00579   if ((n>=3) && is_atomic (t[0]))
00580     for (i=1; i<n-1; i+=2) {
00581       if (!is_atomic (t[i])) continue;
00582       string var  = t[0]->label;
00583       string prop = t[i]->label;
00584       tree   val  = t[i+1];
00585       tree_label l= make_tree_label (var);
00586       if (prop == "arity") {
00587        if (is_tuple (val, "repeat", 2))
00588          drd->set_arity (l, as_int (val [1]), as_int (val [2]),
00589                        ARITY_REPEAT, CHILD_BIFORM);
00590        else if (is_tuple (val, "options", 2))
00591          drd->set_arity (l, as_int (val [1]), as_int (val [2]),
00592                        ARITY_OPTIONS, CHILD_BIFORM);
00593        else
00594          drd->set_arity (l, as_int (val), 0,
00595                        ARITY_NORMAL, CHILD_DETAILED);
00596        drd->freeze_arity (l);
00597       }
00598       else if (prop == "name") {
00599        if (is_atomic (val))
00600          drd->set_attribute (l, prop, val->label);
00601       }
00602       else if (prop == "syntax")
00603         drd->set_syntax (l, val);
00604       else if (prop == "border") {
00605        if (val == "yes") drd->set_border (l, BORDER_YES);
00606        if (val == "inner") drd->set_border (l, BORDER_INNER);
00607        if (val == "outer") drd->set_border (l, BORDER_OUTER);
00608        if (val == "no") drd->set_border (l, BORDER_INNER);
00609        drd->freeze_border (l);
00610       }
00611       else if (prop == "with-like") {
00612        if (val == "yes") drd->set_with_like (l, true);
00613        if (val == "no") drd->set_with_like (l, false);
00614        drd->freeze_with_like (l);
00615       }
00616       else if (prop == "locals") {
00617        int i, n= drd->get_nr_indices (l);
00618        for (i=0; i<n; i++) {
00619          drd->set_env (l, i, val);
00620          drd->freeze_env (l, i);
00621        }
00622       }
00623       else if (prop == "unaccessible" ||
00624               prop == "hidden" ||
00625               prop == "accessible")
00626        {
00627          int prop_code= ACCESSIBLE_NEVER;
00628          if (prop == "hidden") prop_code= ACCESSIBLE_HIDDEN;
00629          if (prop == "accessible") prop_code= ACCESSIBLE_ALWAYS;
00630          if (val == "none") prop_code= ACCESSIBLE_NEVER;
00631          if (is_int (val)) {
00632            int i= as_int (val);
00633            drd->set_accessible (l, i, prop_code);
00634            drd->freeze_accessible (l, i);
00635          }
00636          else if (val == "none" || val == "all") {
00637            int i, n= drd->get_nr_indices (l);
00638            for (i=0; i<n; i++) {
00639              drd->set_accessible (l, i, prop_code);
00640              drd->freeze_accessible (l, i);
00641            }
00642          }
00643        }
00644       else if (prop == "normal-writability" ||
00645          prop == "disable-writability" ||
00646          prop == "enable-writability")
00647        {
00648          int prop_code= WRITABILITY_NORMAL;
00649          if (prop == "disable-writability") prop_code= WRITABILITY_DISABLE;
00650          if (prop == "enable-writability") prop_code= WRITABILITY_ENABLE;
00651          if (is_int (val)) {
00652            int i= as_int (val);
00653            drd->set_writability (l, i, prop_code);
00654            drd->freeze_writability (l, i);
00655          }
00656          else if (val == "all") {
00657            int i, n= drd->get_nr_indices (l);
00658            for (i=0; i<n; i++) {
00659              drd->set_writability (l, i, prop_code);
00660              drd->freeze_writability (l, i);
00661            }
00662          }
00663        }
00664       else if (prop == "returns" && drd_encode_type (as_string (val)) >= 0) {
00665        drd->set_type (l, drd_encode_type (as_string (val)));
00666        drd->freeze_type (l);
00667       }
00668       else if (drd_encode_type (prop) >= 0) {
00669        int tp= drd_encode_type (prop);
00670        if (is_int (val)) {
00671          int i= as_int (val);
00672          drd->set_type (l, i, tp);
00673          drd->freeze_type (l, i);
00674        }
00675        else if (val == "all") {
00676          int i, n= drd->get_nr_indices (l);
00677          for (i=0; i<n; i++) {
00678            drd->set_type (l, i, tp);
00679            drd->freeze_type (l, i);
00680          }
00681        }
00682       }
00683     }
00684   return t;
00685 }
00686 
00687 tree
00688 edit_env_rep::exec_provides (tree t) {
00689   if (N(t)<1) return tree (ERROR, "bad provides");
00690   tree r= exec (t[0]);
00691   if (is_compound (r)) return tree (ERROR, "bad provides");
00692   if (provides (r->label)) return "true"; else return "false";
00693 }
00694 
00695 tree
00696 edit_env_rep::exec_value (tree t) {
00697   if (N(t)<1) return tree (ERROR, "bad value");
00698   tree r= exec (t[0]);
00699   if (is_compound (r)) return tree (ERROR, "bad value");
00700   return exec (read (r->label));
00701 }
00702 
00703 tree
00704 edit_env_rep::exec_quote_value (tree t) {
00705   if (N(t)<1) return tree (ERROR, "bad quote-value");
00706   tree r= exec (t[0]);
00707   if (is_compound (r)) return tree (ERROR, "bad quote-value");
00708   return read (r->label);
00709 }
00710 
00711 tree
00712 edit_env_rep::exec_arg (tree t) {
00713   if (N(t)<1) return tree (ERROR, "bad arg");
00714   tree r= t[0];
00715   if (is_compound (r))
00716     return tree (ERROR, "bad arg");
00717   if (is_nil (macro_arg) || (!macro_arg->item->contains (r->label)))
00718     return tree (ERROR, "arg " * r->label);
00719   r= macro_arg->item [r->label];
00720   list<hashmap<string,tree> > old_var= macro_arg;
00721   list<hashmap<string,path> > old_src= macro_src;
00722   if (!is_nil (macro_arg)) macro_arg= macro_arg->next;
00723   if (!is_nil (macro_src)) macro_src= macro_src->next;
00724   bool err= false;
00725   if (N(t) > 1) {
00726     int i, n= N(t);
00727     for (i=1; i<n; i++) {
00728       tree u= exec (t[i]);
00729       if (!is_int (u)) { err= true; break; }
00730       int nr= as_int (u);
00731       if ((!is_compound (r)) || (nr<0) || (nr>=N(r))) { err= true; break; }
00732       r= r[nr];
00733     }
00734   }
00735   if (err) r= tree (ERROR, "arg " * r->label);
00736   else r= exec (r);
00737   macro_arg= old_var;
00738   macro_src= old_src;
00739   return r;
00740 }
00741 
00742 static bool quote_substitute= false;
00743 
00744 tree
00745 edit_env_rep::exec_quote_arg (tree t) {
00746   if (N(t)<1) return tree (ERROR, "bad quote-arg");
00747   tree r= t[0];
00748   if (is_compound (r))
00749     return tree (ERROR, "bad quote-arg");
00750   if (is_nil (macro_arg) || (!macro_arg->item->contains (r->label)))
00751     return tree (ERROR, "quoted argument " * r->label);
00752   r= macro_arg->item [r->label];
00753   if (N(t) > 1) {
00754     int i, n= N(t);
00755     for (i=1; i<n; i++) {
00756       tree u= exec (t[i]);
00757       if (!is_int (u)) break;
00758       int nr= as_int (u);
00759       if ((!is_compound (r)) || (nr<0) || (nr>=N(r))) break;
00760       r= r[nr];
00761     }
00762   }
00763   if (quote_substitute && !is_func (r, ARG)) {
00764     int i, n= N(r);
00765     tree s (r, n);
00766     for (i=0; i<n; i++)
00767       s[i]= tree (ARG, A(t)) * tree (ARG, as_string (i));
00768     return s;
00769   }
00770   return r;
00771 }
00772 
00773 tree
00774 edit_env_rep::exec_get_label (tree t) {
00775   if (N(t)<1) return tree (ERROR, "bad get-label");
00776   tree r= exec (t[0]);
00777   return copy (as_string (L(r)));
00778 }
00779 
00780 tree
00781 edit_env_rep::exec_get_arity (tree t) {
00782   if (N(t)<1) return tree (ERROR, "bad get-arity");
00783   tree r= exec (t[0]);
00784   return as_string (arity (r));
00785 }
00786 
00787 tree
00788 edit_env_rep::exec_eval_args (tree t) {
00789   if (N(t)<1) return tree (ERROR, "bad eval-args");
00790   if(is_nil(macro_arg)) return tree(ERROR, "nil argument");
00791   tree v= macro_arg->item [as_string (t[0])];
00792   if (is_atomic (v)) return tree (ERROR, "eval arguments " * t[0]->label);
00793   list<hashmap<string,tree> > old_var= macro_arg;
00794   list<hashmap<string,path> > old_src= macro_src;
00795   if (!is_nil (macro_arg)) macro_arg= macro_arg->next;
00796   if (!is_nil (macro_src)) macro_src= macro_src->next;
00797 
00798   int i, n= N(v);
00799   tree r (v, n);
00800   for (i=0; i<n; i++)
00801     r[i]= exec (v[i]);
00802 
00803   macro_arg= old_var;
00804   macro_src= old_src;
00805   return r;
00806 }
00807 
00808 tree
00809 edit_env_rep::exec_quasiquoted (tree t) {
00810   if (is_atomic (t)) return t;
00811   else if (is_func (t, UNQUOTE, 1)) return exec (t[0]);
00812   else {
00813     int i, n= N(t);
00814     tree r (L(t));
00815     for (i=0; i<n; i++) {
00816       if (is_func (t[i], VAR_UNQUOTE, 1)) {
00817        tree ins= exec (t[i]);
00818        if (is_compound (ins)) r << A(ins);
00819        else r << tree (ERROR, "bad unquote*");
00820       }
00821       else r << exec_quasiquoted (t[i]);
00822     }
00823     return r;
00824   }
00825 }
00826 
00827 tree
00828 edit_env_rep::exec_if (tree t) {
00829   // This case must be kept consistent with
00830   // concater_rep::typeset_if(tree, path)
00831   // in ../Concat/concat_active.cpp
00832   if ((N(t)!=2) && (N(t)!=3)) return tree (ERROR, "bad if");
00833   tree tt= exec (t[0]);
00834   if (is_compound (tt) || !is_bool (tt->label))
00835     return tree (ERROR, "bad if");
00836   if (as_bool (tt->label)) return exec (t[1]);
00837   if (N(t)==3) return exec (t[2]);
00838   return "";
00839 }
00840 
00841 tree
00842 edit_env_rep::exec_case (tree t) {
00843   // This case must be kept consistent with
00844   // concater_rep::typeset_case(tree, path)
00845   // in ../Concat/concat_active.cpp
00846   if (N(t)<2) return tree (ERROR, "bad case");
00847   int i, n= N(t);
00848   for (i=0; i<(n-1); i+=2) {
00849     tree tt= exec (t[i]);
00850     if (is_compound (tt) || ! is_bool (tt->label))
00851       return tree (ERROR, "bad case");
00852     if (as_bool (tt->label)) return exec (t[i+1]);
00853   }
00854   if (i<n) return exec (t[i]);
00855   return "";
00856 }
00857 
00858 tree
00859 edit_env_rep::exec_while (tree t) {
00860   if (N(t)!=2) return tree (ERROR, "bad while");
00861   tree r (CONCAT);
00862   while (1) {
00863     tree tt= exec (t[0]);
00864     if (is_compound (tt)) return tree (ERROR, "bad while");
00865     if (! is_bool (tt->label)) return tree (ERROR, "bad while");
00866     if (! as_bool(tt->label)) break;
00867     r << exec (t[1]);
00868   }
00869   if (N(r) == 0) return "";
00870   if (N(r) == 1) return r[0];
00871   return r;
00872 }
00873 
00874 tree
00875 edit_env_rep::exec_for_each (tree t) {
00876   if (N(t)!=2) return tree (ERROR, "bad for-each");
00877   tree fun = exec (t[0]);
00878   tree args= exec (t[1]);
00879   if (!is_tuple (args)) return tree (ERROR, "bad for-each");
00880   int i, n= N(args);
00881   for (i=0; i<n; i++)
00882     exec (tree (COMPOUND, fun, args[i]));
00883   return "";
00884 }
00885 
00886 static tree
00887 filter_style (tree t) {
00888   if (is_atomic (t)) return t;
00889   else switch (L(t)) {
00890   case STYLE_WITH:
00891   case VAR_STYLE_WITH:
00892     return filter_style (t[N(t)-1]);
00893   case STYLE_ONLY:
00894   case VAR_STYLE_ONLY:
00895     if (is_atomic (t[0])) return "";
00896     else return filter_style (t[0][N(t[0])-1]);
00897   case ACTIVE:
00898   case VAR_ACTIVE:
00899   case INACTIVE:
00900   case VAR_INACTIVE:
00901     return filter_style (t[0]);
00902   default:
00903     {
00904       int i, n= N(t);
00905       tree r (t, n);
00906       for (i=0; i<n; i++)
00907        r[i]= filter_style (t[i]);
00908       return r;
00909     }
00910   }
00911 }
00912 
00913 tree
00914 edit_env_rep::exec_use_package (tree t) {
00915   int i, n= N(t);
00916   for (i=0; i<n; i++) {
00917     url styp= "$TEXMACS_STYLE_PATH";
00918     url name= as_string (t[i]) * string (".ts");
00919     //cout << "Package " << name << "\n";
00920     if (is_rooted_web (base_file_name))
00921       styp= styp | head (base_file_name);
00922     else styp= ::expand (head (base_file_name) * url_ancestor ()) | styp;
00923     string doc_s;
00924     if (!load_string (styp * name, doc_s, false)) {
00925       tree doc= texmacs_document_to_tree (doc_s);
00926       if (is_compound (doc))
00927        exec (filter_style (extract (doc, "body")));
00928     }
00929   }
00930   return "";
00931 }
00932 
00933 tree
00934 edit_env_rep::exec_use_module (tree t) {
00935   int i, n= N(t);
00936   for (i=0; i<n; i++) {
00937     string s= exec_string (t[i]);
00938     if (starts (s, "(")) eval ("(use-modules " * s * ")");
00939     else if (s != "") eval ("(plugin-initialize '" * s * ")");
00940     assign (THE_MODULES, read (THE_MODULES) * tuple (s));
00941   }
00942   return "";
00943 }
00944 
00945 tree
00946 edit_env_rep::exec_or (tree t) {
00947   if (N(t)<2) return tree (ERROR, "bad or");
00948   for (int i=0; i<N(t); i++) {
00949     tree ti= exec (t[i]);
00950     if (is_compound (ti)) return tree (ERROR, "bad or");
00951     if (! is_bool (ti->label)) return tree (ERROR, "bad or");
00952     if (as_bool (ti->label)) return as_string_bool (true);
00953   }
00954   return as_string_bool (false);
00955 }
00956 
00957 tree
00958 edit_env_rep::exec_xor (tree t) {
00959   if (N(t)!=2) return tree (ERROR, "bad xor");
00960   tree t1= exec (t[0]);
00961   tree t2= exec (t[1]);
00962   if (is_compound (t1) || is_compound (t2)) return tree (ERROR, "bad xor");
00963   if (!is_bool (t1->label) || !is_bool (t2->label))
00964     return tree (ERROR, "bad xor");
00965   return as_string_bool (as_bool (t1->label) ^ as_bool (t2->label));
00966 }
00967 
00968 tree
00969 edit_env_rep::exec_and (tree t) {
00970   if (N(t)<2) return tree (ERROR, "bad and");
00971   for (int i=0; i<N(t); i++) {
00972     tree ti= exec (t[i]);
00973     if (is_compound (ti)) return tree (ERROR, "bad and");
00974     if (! is_bool (ti->label)) return tree (ERROR, "bad and");
00975     if (! as_bool (ti->label)) return as_string_bool (false);
00976   }
00977   return as_string_bool (true);
00978 }
00979 
00980 tree
00981 edit_env_rep::exec_not (tree t) {
00982   if (N(t)!=1) return tree (ERROR, "bad not");
00983   tree tt= exec(t[0]);
00984   if (is_compound (tt)) return tree (ERROR, "bad not");
00985   if (! is_bool (tt->label)) return tree (ERROR, "bad not");
00986   return as_string_bool (! as_bool (tt->label));
00987 }
00988 
00989 tree
00990 edit_env_rep::exec_plus_minus (tree t) {
00991   int i, n= N(t);
00992   if (n==0) return tree (ERROR, "bad plus/minus");
00993   tree inc= exec (t[0]);
00994   if (is_double (inc)) {
00995     double acc= as_double (inc);
00996     if ((n==1) && is_func (t, MINUS))
00997       acc= -acc;
00998     for (i=1; i<n; i++) {
00999       tree inc= exec (t[i]);
01000       if (!is_double (inc))
01001        return tree (ERROR, "bad plus/minus");
01002       if ((i == n-1) && is_func (t, MINUS))
01003        acc -= as_double (inc);
01004       else acc += as_double (inc);
01005     }
01006     return as_string (acc);
01007   }
01008   else if (is_anylen (inc)) {
01009     tree acc= as_tmlen (inc);
01010     if ((n==1) && is_func (t, MINUS))
01011       acc= tmlen_times (-1, acc);
01012     for (i=1; i<n; i++) {
01013       tree inc= exec (t[i]);
01014       if (!is_anylen (inc))
01015        return tree (ERROR, "bad plus/minus");
01016       inc= as_tmlen (inc);
01017       if ((i == n-1) && is_func (t, MINUS))
01018        inc= tmlen_times (-1, inc);
01019       acc= tmlen_plus (acc, inc);
01020     }
01021     return acc;
01022   }
01023   else return tree (ERROR, "bad plus/minus");
01024 }
01025 
01026 tree
01027 edit_env_rep::exec_min_max (tree t) {
01028   int i, n= N(t);
01029   if (n==0) return tree (ERROR, "bad min/max");
01030   tree first= exec (t[0]);
01031   if (is_double (first)) {
01032     double ret= as_double (first);
01033     for (i=1; i<n; i++) {
01034       tree next= exec (t[i]);
01035       if (!is_double (next))
01036        return tree (ERROR, "bad min/max");
01037       if (is_func (t, MINIMUM))
01038        ret= min (ret, as_double (next));
01039       else
01040        ret= max (ret, as_double (next));
01041     }
01042     return as_string (ret);
01043   }
01044   else if (is_anylen (first)) {
01045     tree ret= as_tmlen (first);
01046     if ((n==1) && is_func (t, MINUS))
01047       ret= tmlen_times (-1, ret);
01048     for (i=1; i<n; i++) {
01049       tree next= exec (t[i]);
01050       if (!is_anylen (next))
01051        return tree (ERROR, "bad min/max");
01052       next= as_tmlen (next);
01053       if (is_func (t, MINIMUM))
01054        ret= tmlen_min (ret, next);
01055       else
01056        ret= tmlen_max (ret, next);
01057     }
01058     return ret;
01059   }
01060   else return tree (ERROR, "bad min/max");
01061 }
01062 
01063 tree
01064 edit_env_rep::exec_times_over (tree t) {
01065   int i, n= N(t);
01066   if (n==0) return tree (ERROR, "bad times/over");
01067   tree prod= exec (t[0]);
01068   if (is_double (prod));
01069   else if (is_anylen (prod)) prod= as_tmlen (prod);
01070   else if (is_percentage (prod)) prod= as_tree (as_percentage (prod));
01071   else return tree (ERROR, "bad times/over");
01072   if ((n==1) && is_func (t, OVER)) {
01073     if (is_double (prod)) return as_string (1 / as_double (prod));
01074     else return tree (ERROR, "bad times/over");
01075   }
01076   // cout << t << "\n";
01077   // cout << "  0\t" << prod << "\n";
01078   for (i=1; i<n; i++) {
01079     tree mul= exec (t[i]);
01080     if (is_double (mul)) {
01081       double _mul= as_double (mul);
01082       if ((i == n-1) && is_func (t, OVER))
01083        _mul= 1 / _mul;
01084       if (is_double (prod))
01085        prod= as_string (_mul * as_double (prod));
01086       else prod= tmlen_times (_mul, prod);
01087     }
01088     else if (is_anylen (mul)) {
01089       mul= as_tmlen (mul);
01090       if ((i == n-1) && is_func (t, OVER)) {
01091        if (!is_func (prod, TMLEN))
01092          return tree (ERROR, "bad times/over");
01093        return tmlen_over (prod, mul);
01094       }
01095       if (is_double (prod))
01096        prod= tmlen_times (as_double (prod), mul);
01097       else return tree (ERROR, "bad times/over");
01098     }
01099     else if (is_percentage (mul)) {
01100       double _mul= as_percentage (mul);
01101       if (is_double (prod))
01102        prod= as_string (_mul * as_double (prod));
01103       else prod= tmlen_times (_mul, prod);
01104     }
01105     else return tree (ERROR, "bad times/over");
01106     // cout << "  " << i << "\t" << prod << "\n";
01107   }
01108   return prod;
01109 }
01110 
01111 tree
01112 edit_env_rep::exec_divide (tree t) {
01113   /* this doesn't match the documentation */
01114   if (N(t)!=2) return tree (ERROR, "bad divide");
01115   tree t1= exec (t[0]);
01116   tree t2= exec (t[1]);
01117   if (is_compound (t1) || is_compound (t2))
01118     return tree (ERROR, "bad divide");
01119   if (is_int (t1->label) && (is_int (t2->label))) {
01120     int den= as_int (t2->label);
01121     if (den == 0) return tree (ERROR, "division by zero");
01122     return as_string (as_int (t1->label) / den);
01123   }
01124   if (is_double (t1->label) && (is_double (t2->label))) {
01125     double den= as_double (t2->label);
01126     if (den == 0) return tree (ERROR, "division by zero");
01127     return as_string (floor (as_double (t1->label) / den));
01128   }
01129   if (is_anylen (t1->label) && (is_anylen (t2->label)))
01130     return as_string (tmlen_div (as_tmlen (t1), as_tmlen (t2)));
01131   return tree (ERROR, "bad divide");
01132 }
01133 
01134 tree
01135 edit_env_rep::exec_modulo (tree t) {
01136   if (N(t)!=2) return tree (ERROR, "bad modulo");
01137   tree t1= exec (t[0]);
01138   tree t2= exec (t[1]);
01139   if (is_compound (t1) || is_compound (t2))
01140     return tree (ERROR, "bad modulo");
01141   if (is_int (t1->label) && (is_int (t2->label))) {
01142     int den= as_int (t2->label);
01143     if (den == 0) return tree (ERROR, "modulo zero");
01144     return as_string (as_int (t1->label) % den);
01145   }
01146   if (is_double (t1->label) && (is_double (t2->label))) {
01147     double num= as_double (t1->label);
01148     double den= as_double (t2->label);
01149     if (den == 0) return tree (ERROR, "modulo zero");
01150     double div= floor (num / den);
01151     return as_string (num - div * den);
01152   }
01153   if (is_anylen (t1->label) && (is_anylen (t2->label)))
01154     return tmlen_mod (as_tmlen (t1), as_tmlen (t2));
01155   return tree (ERROR, "bad modulo");
01156 }
01157 
01158 tree
01159 edit_env_rep::exec_math_sqrt (tree t) {
01160   if (N(t)!=1) return tree (ERROR, "bad sqrt");
01161   tree t1= exec (t[0]);
01162   if (is_double (t1))
01163     return as_tree (sqrt (as_double (t1)));
01164   return tree (ERROR, "bad sqrt");
01165 }
01166 
01167 tree
01168 edit_env_rep::exec_exp (tree t) {
01169   if (N(t)!=1) return tree (ERROR, "bad exp");
01170   tree t1= exec (t[0]);
01171   if (is_double (t1))
01172     return as_tree (exp (as_double (t1)));
01173   return tree (ERROR, "bad exp");
01174 }
01175 
01176 tree
01177 edit_env_rep::exec_log (tree t) {
01178   if (N(t)!=1) return tree (ERROR, "bad log");
01179   tree t1= exec (t[0]);
01180   if (is_double (t1))
01181     return as_tree (log (as_double (t1)));
01182   return tree (ERROR, "bad log");
01183 }
01184 
01185 tree
01186 edit_env_rep::exec_pow (tree t) {
01187   if (N(t)!=2) return tree (ERROR, "bad pow");
01188   tree t1= exec (t[0]);
01189   tree t2= exec (t[1]);
01190   if (is_double (t1) && is_double (t2))
01191     return as_tree (pow (as_double (t1), as_double (t2)));
01192   return tree (ERROR, "bad pow");
01193 }
01194 
01195 tree
01196 edit_env_rep::exec_cos (tree t) {
01197   if (N(t)!=1) return tree (ERROR, "bad cos");
01198   tree t1= exec (t[0]);
01199   if (is_double (t1))
01200     return as_tree (cos (as_double (t1)));
01201   return tree (ERROR, "bad cos");
01202 }
01203 
01204 tree
01205 edit_env_rep::exec_sin (tree t) {
01206   if (N(t)!=1) return tree (ERROR, "bad sin");
01207   tree t1= exec (t[0]);
01208   if (is_double (t1))
01209     return as_tree (sin (as_double (t1)));
01210   return tree (ERROR, "bad sin");
01211 }
01212 
01213 tree
01214 edit_env_rep::exec_tan (tree t) {
01215   if (N(t)!=1) return tree (ERROR, "bad tan");
01216   tree t1= exec (t[0]);
01217   if (is_double (t1))
01218     return as_tree (tan (as_double (t1)));
01219   return tree (ERROR, "bad tan");
01220 }
01221 
01222 tree
01223 edit_env_rep::exec_merge (tree t) {
01224   int i, n= N(t);
01225   if (n == 0) return "";
01226   tree acc= exec (t[0]);
01227   if (is_concat (acc)) acc= tree_as_string (acc);
01228   for (i=1; i<n; i++) {
01229     tree add= exec (t[i]);
01230     if (is_atomic (acc) &&
01231        (is_atomic (add) || is_concat (add) || is_document (add)))
01232       acc= acc->label * tree_as_string (add);
01233     else if (is_tuple (acc) && is_tuple (add))
01234       acc= acc * add;
01235     else if (is_func (acc, MACRO) && is_func (add, MACRO) &&
01236             (N(acc) == N(add)) &&
01237             (acc (0, N(acc)-1) == add (0, N(add)-1)))
01238       {
01239        tree r = copy (acc);
01240        tree u1= copy (acc[N(acc)-1]);
01241        tree u2= copy (add[N(add)-1]);
01242        tree u (CONCAT, u1, u2);
01243        if (u1 == "") u= u2;
01244        else if (u2 == "") u= u1;
01245        else if (is_atomic (u1) && is_atomic (u2))
01246          u= u1->label * u2->label;
01247        r[N(r)-1]= u;
01248        acc= r;
01249       }
01250     else {
01251       //cout << "acc= " << acc << "\n";
01252       //cout << "add= " << add << "\n";
01253       return tree (ERROR, "bad merge");
01254     }
01255   }
01256   return acc;
01257 }
01258 
01259 tree
01260 edit_env_rep::exec_length (tree t) {
01261   if (N(t)!=1) return tree (ERROR, "bad length");
01262   tree t1= exec (t[0]);
01263   if (is_compound (t1)) {
01264     if (is_tuple (t1)) return as_string (N (t1));
01265     return tree (ERROR, "bad length");
01266   }
01267   return as_string (N (t1->label));
01268 }
01269 
01270 tree
01271 edit_env_rep::exec_range (tree t) {
01272   if (N(t)!=3) return tree (ERROR, "bad range");
01273   tree t1= exec (t[0]);
01274   tree t2= exec (t[1]);
01275   tree t3= exec (t[2]);
01276   if (!(is_int (t2) && is_int (t3))) return tree (ERROR, "bad range");
01277   if (is_compound (t1)) {
01278     if (is_tuple (t1)) {
01279       int i1= max (0, as_int (t2));
01280       int i2= min (N (t1), as_int (t3));
01281       i2 = max (i1, i2);
01282       return t1 (i1, i2);
01283     }
01284     return tree (ERROR, "bad range");
01285   }
01286   int i1= max (0, as_int (t2));
01287   int i2= min (N(t1->label), as_int (t3));
01288   i2 = max (i1, i2);
01289   return t1->label (i1, i2);
01290 }
01291 
01292 tree
01293 edit_env_rep::exec_number (tree t) {
01294   if (N(t)!=2) return tree (ERROR, "bad number");
01295   tree t1= exec (t[0]);
01296   tree t2= exec (t[1]);
01297   if (is_compound (t1) || is_compound (t2))
01298     return tree (ERROR, "bad number");
01299   string s1= t1->label;
01300   string s2= t2->label;
01301   int nr= as_int (s1);
01302   if (s2 == "arabic") return as_string (nr);
01303   if (s2 == "roman") return roman_nr (nr);
01304   if (s2 == "Roman") return Roman_nr (nr);
01305   if (s2 == "alpha") return alpha_nr (nr);
01306   if (s2 == "Alpha") return Alpha_nr (nr);
01307   if (s2 == "fnsymbol")
01308     return tree (WITH, MODE, "math", tree (RIGID, fnsymbol_nr (nr)));
01309   return tree (ERROR, "bad number");
01310 }
01311 
01312 tree
01313 edit_env_rep::exec_date (tree t) {
01314   if (N(t)>2) return tree (ERROR, "bad date");
01315   string lan= get_string (LANGUAGE);
01316   if (N(t) == 2) {
01317     tree u= exec (t[1]);
01318     if (is_compound (u)) return tree (ERROR, "bad date");
01319     lan= u->label;
01320   }
01321   string fm= "";
01322   if (N(t) != 0) {
01323     tree u= exec (t[0]);
01324     if (is_compound (u)) return tree (ERROR, "bad date");
01325     fm= u->label;
01326   }
01327   return get_date (lan, fm);
01328 }
01329 
01330 tree
01331 edit_env_rep::exec_translate (tree t) {
01332   if (N(t)!=3) return tree (ERROR, "bad translate");
01333   tree t1= exec (t[0]);
01334   tree t2= exec (t[1]);
01335   tree t3= exec (t[2]);
01336   if (is_compound (t1) || is_compound (t2) || is_compound (t3))
01337     return tree (ERROR, "bad translate");
01338   return translate (t1->label, t2->label, t3->label);
01339 }
01340 
01341 tree
01342 edit_env_rep::exec_change_case (tree t, tree nc, bool exec_flag, bool first) {
01343   if (is_atomic (t)) {
01344     string s= t->label;
01345     tree   r= copy (s);
01346     int i, n= N(s);
01347 
01348     bool all= true;
01349     bool up = false;
01350     bool lo = false;
01351     if (nc == "Upcase") { all= false; up= true; }
01352     else if (nc == "UPCASE") { up= true; }
01353     else if (nc == "locase") { lo= true; }
01354 
01355     for (i=0; i<n; tm_char_forwards (s, i))
01356       if (is_iso_alpha (s[i]) && (all || (first && (i==0)))) {
01357        if (up && is_locase (s[i])) r->label[i]= upcase (s[i]);
01358        if (lo && is_upcase (s[i])) r->label[i]= locase (s[i]);
01359       }
01360     r->obs= list_observer (ip_observer (obtain_ip (t)), r->obs);
01361     return r;
01362   }
01363   else if (is_concat (t)) {
01364     int i, n= N(t);
01365     tree r (t, n);
01366     for (i=0; i<n; i++)
01367       r[i]= exec_change_case (t[i], nc, exec_flag, first && (i==0));
01368     r->obs= list_observer (ip_observer (obtain_ip (t)), r->obs);
01369     return r;
01370   }
01371   else {
01372     if (exec_flag) return t;
01373     else return exec_change_case (exec (t), nc, true, first);
01374   }
01375 }
01376 
01377 tree
01378 edit_env_rep::exec_change_case (tree t) {
01379   if (N(t) < 2) return tree (ERROR, "bad change case");
01380   return exec_change_case (t[0], exec (t[1]), false, true);
01381 }
01382 
01383 tree
01384 edit_env_rep::exec_find_file (tree t) {
01385   int i, n=N(t);
01386   array<tree> r (n);
01387   for (i=0; i<n; i++) {
01388     r[i]= exec (t[i]);
01389     if (is_compound (r[i]))
01390       return tree (ERROR, "bad find file");
01391   }
01392   for (i=0; i<(n-1); i++) {
01393     url u= resolve (url (r[i]->label, r[n-1]->label));
01394     if (!is_none (u)) {
01395       if (is_rooted (u, "default")) u= reroot (u, "file");
01396       return as_string (u);
01397     }
01398   }
01399   url u= resolve (base_file_name * url_parent () * r[n-1]->label);
01400   if (!is_none (u)) {
01401     if (is_rooted (u, "default")) u= reroot (u, "file");
01402     return as_string (u);
01403   }
01404   return "false";
01405 }
01406 
01407 tree
01408 edit_env_rep::exec_is_tuple (tree t) {
01409   if (N(t)!=1) return tree (ERROR, "bad tuple query");
01410   return as_string_bool(is_tuple (exec (t[0])));
01411 }
01412 
01413 tree
01414 edit_env_rep::exec_lookup (tree t) {
01415   if (N(t)!=2) return tree (ERROR, "bad look up");
01416   tree t1= exec (t[0]);
01417   tree t2= exec (t[1]);
01418   if (!(is_compound (t1) && is_int (t2))) return tree (ERROR, "bad look up");
01419   int i= as_int (t2);
01420   if (i<0 || i>=N(t1)) return tree (ERROR, "index out of range in look up");
01421   return t1[i];
01422 }
01423 
01424 tree
01425 edit_env_rep::exec_equal (tree t) {
01426   if (N(t)!=2) return tree (ERROR, "bad equal");
01427   tree t1= exec (t[0]);
01428   tree t2= exec (t[1]);
01429   if (is_atomic (t1) && is_atomic (t2)
01430       && is_length (t1->label) && is_length (t2->label))
01431     return as_string_bool (as_length (t1) == as_length (t2));
01432   return as_string_bool (t1 == t2);
01433 }
01434 
01435 tree
01436 edit_env_rep::exec_unequal (tree t) {
01437   if (N(t)!=2) return tree (ERROR, "bad unequal");
01438   tree t1= exec (t[0]);
01439   tree t2= exec (t[1]);
01440   if (is_atomic(t1) && is_atomic(t2)
01441       && is_length(t1->label) && is_length(t2->label))
01442     return as_string_bool (as_length (t1) != as_length (t2));
01443   return as_string_bool (t1 != t2);
01444 }
01445 
01446 tree
01447 edit_env_rep::exec_less (tree t) {
01448   if (N(t)!=2) return tree (ERROR, "bad less");
01449   tree t1= exec (t[0]);
01450   tree t2= exec (t[1]);
01451   if (is_compound (t1) || is_compound (t2))
01452     return tree (ERROR, "bad less");
01453   string s1= t1->label;
01454   string s2= t2->label;
01455   if (is_double (s1) && is_double (s2))
01456     return as_string_bool (as_double (s1) < as_double (s2));
01457   if (is_length (s1) && is_length (s2))
01458     return as_string_bool (as_length (s1) < as_length (s2));
01459   return tree (ERROR, "bad less");
01460 }
01461 
01462 tree
01463 edit_env_rep::exec_lesseq (tree t) {
01464   if (N(t)!=2) return tree (ERROR, "bad less or equal");
01465   tree t1= exec (t[0]);
01466   tree t2= exec (t[1]);
01467   if (is_compound (t1) || is_compound (t2))
01468     return tree (ERROR, "bad less or equal");
01469   string s1= t1->label;
01470   string s2= t2->label;
01471   if (is_double (s1) && (is_double (s2)))
01472     return as_string_bool (as_double (s1) <= as_double (s2));
01473   if (is_length (s1) && is_length (s2))
01474     return as_string_bool (as_length (s1) <= as_length (s2));
01475   return tree (ERROR, "bad less or equal");
01476 }
01477 
01478 tree
01479 edit_env_rep::exec_greater (tree t) {
01480   if (N(t)!=2) return tree (ERROR, "bad greater");
01481   tree t1= exec (t[0]);
01482   tree t2= exec (t[1]);
01483   if (is_compound (t1) || is_compound (t2))
01484     return tree (ERROR, "bad greater");
01485   string s1= t1->label;
01486   string s2= t2->label;
01487   if (is_double (s1) && (is_double (s2)))
01488     return as_string_bool (as_double (s1) > as_double (s2));
01489   if (is_length (s1) && is_length (s2))
01490     return as_string_bool (as_length (s1) > as_length (s2));
01491   return tree (ERROR, "bad greater");
01492 }
01493 
01494 tree
01495 edit_env_rep::exec_greatereq (tree t) {
01496   if (N(t)!=2) return tree (ERROR, "bad greater or equal");
01497   tree t1= exec (t[0]);
01498   tree t2= exec (t[1]);
01499   if (is_compound (t1) || is_compound (t2))
01500     return tree (ERROR, "bad greater or equal");
01501   string s1= t1->label;
01502   string s2= t2->label;
01503   if (is_double (s1) && (is_double (s2)))
01504     return as_string_bool (as_double (s1) >= as_double (s2));
01505   if (is_length (s1) && is_length (s2))
01506     return as_string_bool (as_length (s1) >= as_length (s2));
01507   return tree (ERROR, "bad greater or equal");
01508 }
01509 
01510 tree
01511 edit_env_rep::exec_hard_id (tree t) {
01512   pointer ptr= (pointer) this;
01513   if (N(t) == 0)
01514     return "%" * as_hexadecimal (ptr);
01515   else {
01516     t= expand (t[0], true);
01517     pointer tptr= (pointer) t.operator -> ();
01518     if (is_accessible (obtain_ip (t)))
01519       return "%" * as_hexadecimal (ptr) *
01520              "-" * as_hexadecimal (tptr);
01521     else {
01522       int h= hash (t);
01523       return "%" * as_hexadecimal (ptr) *
01524              "-" * as_hexadecimal (tptr) *
01525              "-" * as_hexadecimal (h);
01526     }
01527   }
01528 }
01529 
01530 tree
01531 edit_env_rep::exec_script (tree t) {
01532   if (N(t) != 1 && N(t) != 2) return tree (ERROR, "bad script");
01533   if (N(t) == 1) return tree (SCRIPT, exec (t[0]));
01534   else return tree (SCRIPT, exec (t[0]), expand (t[1], true));
01535 }
01536 
01537 tree
01538 edit_env_rep::exec_set_binding (tree t) {
01539   tree keys, value;
01540   if (N(t) == 1) {
01541     keys= read ("the-tags");
01542     if (!is_tuple (keys)) {
01543       //cout << "t= " << t << "\n";
01544       //cout << "keys= " << keys << "\n";
01545       return tree (ERROR, "bad set binding");
01546     }
01547     for (int i=0; i<N(keys); i++)
01548       if (!is_atomic (keys[i])) {
01549        //cout << "t= " << t << "\n";
01550        //cout << "keys= " << keys << "\n";
01551        return tree (ERROR, "bad set binding");
01552       }
01553     value= exec (t[0]);
01554     assign (string ("the-tags"), tree (TUPLE));
01555     assign (string ("the-label"), copy (value));
01556   }
01557   else if (N(t) >= 2) {
01558     tree key= exec (t[0]);
01559     if (!is_atomic (key)) {
01560       //cout << "t= " << t << "\n";
01561       //cout << "key= " << key << "\n";
01562       return tree (ERROR, "bad set binding");
01563     }
01564     keys= tuple (key);
01565     value= exec (t[1]);
01566   }
01567   else {
01568     //cout << "t= " << t << "\n";
01569     return tree (ERROR, "bad set binding");
01570   }
01571   //cout << t << ": " << keys << " -> " << value << "\n";
01572 
01573   for (int i=0; i<N(keys); i++) {
01574     string key= keys[i]->label;
01575     tree old_value= local_ref[key];
01576     string part= as_string (read ("current-part"));
01577     if (is_func (old_value, TUPLE) && (N(old_value) >= 2))
01578       local_ref (key)= tuple (copy (value), old_value[1]);
01579     else local_ref (key)= tuple (copy (value), "?");
01580     if (cur_file_name != base_file_name || N(part) != 0) {
01581       string extra;
01582       if (cur_file_name != base_file_name)
01583        extra << as_string (delta (base_file_name, cur_file_name));
01584       if (N(part) != 0)
01585        extra << "#" << part (1, N(part));
01586       local_ref (key) << extra;
01587     }
01588     if (complete && is_tuple (old_value) && N(old_value) >= 1) {
01589       string old_s= tree_as_string (old_value[0]);
01590       string new_s= tree_as_string (value);
01591       if (new_s != old_s && !starts (key, "auto-")) {
01592        if (new_s == "") system_warning ("Redefined", key);
01593        else system_warning ("Redefined " * key * " as", new_s);
01594       }
01595     }
01596   }
01597   return tree (HIDDEN, keys);
01598 }
01599 
01600 tree
01601 edit_env_rep::exec_get_binding (tree t) {
01602   if (N(t) != 1 && N(t) != 2) return tree (ERROR, "bad get binding");
01603   string key= exec_string (t[0]);
01604   tree value= local_ref->contains (key)? local_ref [key]: global_ref [key];
01605   int type= (N(t) == 1? 0: as_int (exec_string (t[1])));
01606   if (type != 0 && type != 1) type= 0;
01607   if (is_func (value, TUPLE) && (N(value) >= 2)) value= value[type];
01608   else if (type == 1) value= tree (UNINIT);
01609   if (complete && value == tree (UNINIT))
01610     system_warning ("Undefined reference", key);
01611   //cout << t << ": " << key << " -> " << value << "\n";
01612   return value;
01613 }
01614 
01615 tree
01616 edit_env_rep::exec_pattern (tree t) {
01617   if (N(t)<1) return tree (ERROR, "bad pattern");
01618   url im= exec_string (t[0]);
01619   url image= resolve (relative (base_file_name, im));
01620   if (is_none (image))
01621     image= resolve (url ("$TEXMACS_PATTERN_PATH") * im);
01622   if (is_none (image)) return "white";
01623   int imw_pt, imh_pt;
01624   image_size (image, imw_pt, imh_pt);
01625   double pt= ((double) dpi*PIXEL) / 72.0;
01626   SI imw= (SI) (((double) imw_pt) * pt);
01627   SI imh= (SI) (((double) imh_pt) * pt);
01628   if (imw <= 0 || imh <= 0) return "white";
01629   if (N(t)<3) return tree (ERROR, "bad pattern");
01630   string w= exec_string (t[1]);
01631   string h= exec_string (t[2]);
01632   if (is_length (w))
01633     w= as_string (as_length (w));
01634   else if (is_magnification (w))
01635     w= as_string ((SI) (get_magnification (w) * ((double) imw)));
01636   if (is_length (h))
01637     h= as_string (as_length (h));
01638   else if (is_magnification (h))
01639     h= as_string ((SI) (get_magnification (h) * ((double) imh)));
01640   if (w == "" && h != "") {
01641     if (is_int (h)) w= as_string ((SI) ((as_double (h) * imw) / imh));
01642     else if (is_percentage (h))
01643       w= as_string (100.0 * (as_percentage (h) * imw) / imh) * "@";
01644     else return "white";
01645   }
01646   else if (h == "" && w != "") {
01647     if (is_int (w)) h= as_string ((SI) ((as_double (w) * imh) / imw));
01648     else if (is_percentage (w))
01649       h= as_string (100.0 * (as_percentage (w) * imh) / imw) * "@";
01650     else return "white";
01651   }
01652   else if (w == "" && h == "") {
01653     w= as_string (imw);
01654     h= as_string (imh);
01655   }
01656   else if ((!is_int (w) && !is_percentage (w)) ||
01657           (!is_int (h) && !is_percentage (h)))
01658     return "white";
01659   tree r (PATTERN, as_string (image), w, h);
01660   if (N(t) == 4) r << exec (t[3]);
01661   return r;
01662 }
01663 
01664 tree
01665 edit_env_rep::exec_point (tree t) {
01666   int i, n= N(t);
01667   tree u (_POINT, n);
01668   for (i=0; i<n; i++)
01669     u[i]= exec (t[i]);
01670   if (n==0 || is_double (u[0])) return u;
01671   return as_tree (as_point (u));
01672 }
01673 
01674 tree
01675 edit_env_rep::exec_box_info (tree t) {
01676   if (N(t)<2) return tree (ERROR, "bad box-info");
01677   tree t1= t[0];
01678   tree t2= t[1];
01679   if (!is_string (t2))
01680     return tree (ERROR, "bad box info");
01681   return box_info (edit_env (this), t1, as_string (t2));
01682 }
01683 
01684 tree
01685 edit_env_rep::exec_frame_direct (tree t) {
01686   if (N(t)<1) return tree (ERROR, "bad frame-direct");
01687   tree t1= exec (t[0]);
01688   return as_tree (!is_nil (fr) ? fr (::as_point (t1)) : point ());
01689 }
01690 
01691 tree
01692 edit_env_rep::exec_frame_inverse (tree t) {
01693   if (N(t)<1) return tree (ERROR, "bad frame-inverse");
01694   tree t1= exec (t[0]);
01695   return as_tree (!is_nil (fr) ? fr [::as_point (t1)] : point ());
01696 }
01697 
01698 /******************************************************************************
01699 * Partial evaluation of trees
01700 ******************************************************************************/
01701 
01702 void
01703 edit_env_rep::exec_until (tree t, path p) {
01704   // cout << "Execute " << t << " until " << p << "\n";
01705   if (is_nil (p)) return;
01706   if (is_atom (p)) {
01707     if (p->item!=0)
01708       (void) exec (t);
01709     return;
01710   }
01711 
01712   switch (L(t)) {
01713   case DATOMS:
01714     exec_until_formatting (t, p, ATOM_DECORATIONS);
01715     return;
01716   case DLINES:
01717     exec_until_formatting (t, p, LINE_DECORATIONS);
01718     return;
01719   case DPAGES:
01720     exec_until_formatting (t, p, PAGE_DECORATIONS);
01721     return;
01722   case TFORMAT:
01723     exec_until_formatting (t, p, CELL_FORMAT);
01724     return;
01725   case TABLE:
01726     exec_until_table (t, p);
01727     return;
01728   case WITH:
01729     exec_until_with (t, p);
01730     return;
01731   case COMPOUND:
01732     exec_until_compound (t, p);
01733     return;
01734   case MARK:
01735     if (p->item == 1) exec_until (t[1], p->next);
01736     return;
01737   case STYLE_WITH:
01738   case VAR_STYLE_WITH:
01739     if (p->item == (N(t)-1)) exec_until (t[N(t)-1], p->next);
01740     return;
01741   case STYLE_ONLY:
01742   case VAR_STYLE_ONLY:
01743   case ACTIVE:
01744   case VAR_ACTIVE:
01745   case INACTIVE:
01746   case VAR_INACTIVE:
01747     exec_until_compound (t, p);
01748     return;
01749   case HLINK:
01750   case ACTION:
01751     exec_until_compound (t, p);
01752     return;
01753   default:
01754     if (L(t) < START_EXTENSIONS) {
01755       int i;
01756       for (i=0; i<p->item; i++) (void) exec (t[i]);
01757       exec_until (t[p->item], p->next);
01758     }
01759     else exec_until_compound (t, p);
01760     return;
01761   }
01762 }
01763 
01764 void
01765 edit_env_rep::exec_until_formatting (tree t, path p, string v) {
01766   int n= N(t);
01767   if (p->item != n-1) return;
01768   tree oldv= read (v);
01769   tree newv= oldv * t (0, n-1);
01770   monitored_write_update (v, newv);
01771   exec_until (t[n-1], p->next);
01772 }
01773 
01774 void
01775 edit_env_rep::exec_until_table (tree t, path p) {
01776   // should execute values in oldv
01777   monitored_write_update (CELL_FORMAT, tree (TFORMAT));
01778   int i;
01779   for (i=0; i<p->item; i++)
01780     (void) exec (t[i]);
01781   exec_until (t[p->item], p->next);
01782   return;
01783 }
01784 
01785 void
01786 edit_env_rep::exec_until_with (tree t, path p) {
01787   int i, n= N(t), k= (n-1)>>1; // is k=0 allowed ?
01788   if (((n&1) != 1) || (p->item != n-1)) return;
01789   STACK_NEW_ARRAY(vars,string,k);
01790   STACK_NEW_ARRAY(newv,tree,k);
01791   for (i=0; i<k; i++) {
01792     tree var_t= exec (t[i<<1]);
01793     if (is_atomic (var_t)) {
01794       string var= var_t->label;
01795       vars[i]= var;
01796       newv[i]= exec (t[(i<<1)+1]);
01797     }
01798     else {
01799       STACK_DELETE_ARRAY(vars);
01800       STACK_DELETE_ARRAY(newv);
01801       return;
01802     }
01803   }
01804   for (i=0; i<k; i++) monitored_write_update (vars[i], newv[i]);
01805   exec_until (t[n-1], p->next);
01806   STACK_DELETE_ARRAY(vars);
01807   STACK_DELETE_ARRAY(newv);
01808   return;
01809 }
01810 
01811 void
01812 edit_env_rep::exec_until_compound (tree t, path p) {
01813   int d; tree f;
01814   if (L(t) == COMPOUND) {
01815     d= 1;
01816     f= t[0];
01817     if (is_compound (f)) f= exec (f);
01818     if (is_compound (f)) return;
01819     string fname= f->label;
01820     if (!provides (fname)) return;
01821     f= read (fname);
01822   }
01823   else {
01824     string fname= as_string (L(t));
01825     if (!provides (fname)) return;
01826     d= 0;
01827     f= read (fname);
01828   }
01829 
01830   string var;
01831   if (L(f) == XMACRO) var= f[0]->label;
01832   else {
01833     if ((p->item < d) || (p->item >= N(f)) ||
01834        is_compound (f[p->item-d])) return;
01835     var= f[p->item-d]->label;
01836   }
01837 
01838   if (is_applicable (f)) {
01839     int i, n=N(f)-1, m=N(t)-d;
01840     macro_arg= list<hashmap<string,tree> >
01841       (hashmap<string,tree> (UNINIT), macro_arg);
01842     macro_src= list<hashmap<string,path> >
01843       (hashmap<string,path> (path (DECORATION)), macro_src);
01844     if (L(f) == XMACRO) {
01845       if (is_atomic (f[0])) {
01846        macro_arg->item (f[0]->label)= t;
01847        macro_src->item (f[0]->label)= obtain_ip (t);
01848       }
01849       (void) exec_until (f[n], p, var, 0);
01850     }
01851     else {
01852       for (i=0; i<n; i++)
01853        if (is_atomic (f[i])) {
01854          tree st= i<m? t[i+d]: tree (UNINIT);
01855          macro_arg->item (f[i]->label)= st;
01856          macro_src->item (f[i]->label)= obtain_ip (st);
01857        }
01858       (void) exec_until (f[n], p->next, var, 0);
01859     }
01860     macro_arg= macro_arg->next;
01861     macro_src= macro_src->next;
01862   }
01863 }
01864 
01865 bool
01866 edit_env_rep::exec_until (tree t, path p, string var, int level) {
01867   // cout << "Execute " << t << " until " << p
01868   //      << " inside " << var << " level " << level << "\n";
01869   if (is_atomic (t)) return false;
01870   switch (L(t)) {
01871   case DATOMS:
01872     return exec_until_formatting (t, p, var, level, ATOM_DECORATIONS);
01873   case DLINES:
01874     return exec_until_formatting (t, p, var, level, LINE_DECORATIONS);
01875   case DPAGES:
01876     return exec_until_formatting (t, p, var, level, PAGE_DECORATIONS);
01877   case TFORMAT:
01878     return exec_until_formatting (t, p, var, level, CELL_FORMAT);
01879   case TABLE:
01880     return exec_until_table (t, p, var, level);
01881   case ASSIGN:
01882     (void) exec (t);
01883     return false;
01884   case WITH:
01885     return exec_until_with (t, p, var, level);
01886   case PROVIDES:
01887     (void) exec (t);
01888     return false;
01889   case VALUE:
01890     /*
01891     {
01892       tree r= t[0];
01893       if (is_compound (r)) r= exec (r);
01894       if (is_atomic (r) && (r->label == var)) {
01895        exec_until (read (r->label), p);
01896        return true;
01897       }
01898     }
01899     */
01900     (void) exec (t);
01901     return false;
01902   case QUOTE_VALUE:
01903     (void) exec (t);
01904     return false;
01905   case MACRO:
01906   case DRD_PROPS:
01907     (void) exec (t);
01908     return false;
01909   case ARG:
01910     return exec_until_arg (t, p, var, level);
01911   case QUOTE_ARG:
01912     (void) exec (t);
01913     return false;
01914   case COMPOUND:
01915     return exec_until_compound (t, p, var, level);
01916   case XMACRO:
01917   case GET_LABEL:
01918   case GET_ARITY:
01919     (void) exec (t);
01920     return false;
01921   case MAP_ARGS:
01922   case EVAL_ARGS:
01923     return exec_until_rewrite (t, p, var, level);
01924   case MARK:
01925     return exec_until_mark (t, p, var, level);
01926   case EVAL:
01927     return exec_until (exec (t), p, var, level);
01928   case QUOTE:
01929     (void) exec (t);
01930     return false;
01931   case QUASI:
01932     return exec_until_quasi (t, p, var, level);
01933   case QUASIQUOTE:
01934   case UNQUOTE:
01935   case VAR_UNQUOTE:
01936     (void) exec (t);
01937     return false;
01938   case IF:
01939   case VAR_IF:
01940     return exec_until_if (t, p, var, level);
01941   case CASE:
01942     return exec_until_case (t, p, var, level);
01943   case WHILE:
01944     return exec_until_while (t, p, var, level);
01945   case FOR_EACH:
01946     (void) exec (t);
01947     return false;
01948   case EXTERN:
01949   case INCLUDE:
01950     return exec_until_rewrite (t, p, var, level);
01951   case USE_PACKAGE:
01952   case USE_MODULE:
01953   case OR:
01954   case XOR:
01955   case AND:
01956   case NOT:
01957   case PLUS:
01958   case MINUS:
01959   case TIMES:
01960   case OVER:
01961   case DIV:
01962   case MOD:
01963   case MERGE:
01964   case LENGTH:
01965   case RANGE:
01966   case NUMBER:
01967   case _DATE:
01968   case TRANSLATE:
01969   case FIND_FILE:
01970   case IS_TUPLE:
01971   case LOOK_UP:
01972   case EQUAL:
01973   case UNEQUAL:
01974   case LESS:
01975   case LESSEQ:
01976   case GREATER:
01977   case GREATEREQ:
01978     (void) exec (t);
01979     return false;
01980   case STYLE_WITH:
01981   case VAR_STYLE_WITH:
01982     return exec_until (t[N(t)-1], p, var, level);
01983   case STYLE_ONLY:
01984   case VAR_STYLE_ONLY:
01985   case ACTIVE:
01986   case VAR_ACTIVE:
01987   case INACTIVE:
01988   case VAR_INACTIVE:
01989     return exec_until_compound (t, p, var, level);
01990   case REWRITE_INACTIVE:
01991     return exec_until_rewrite (t, p, var, level);
01992   case HLINK:
01993   case ACTION:
01994     return exec_until_compound (t, p, var, level);
01995   default:
01996     if (L(t) < START_EXTENSIONS) {
01997       int i, n= N(t);
01998       for (i=0; i<n; i++)
01999        if (exec_until (t[i], p, var, level))
02000          return true;
02001       return false;
02002     }
02003     else return exec_until_compound (t, p, var, level);
02004   }
02005 }
02006 
02007 bool
02008 edit_env_rep::exec_until_formatting (
02009   tree t, path p, string var, int level, string v)
02010 {
02011   int n= N(t);
02012   tree oldv= read (v);
02013   tree newv= oldv * t (0, n-1);
02014   monitored_write_update (v, newv);
02015   if (exec_until (t[n-1], p, var, level)) return true;
02016   monitored_write_update (v, oldv);
02017   return false;
02018 }
02019 
02020 bool
02021 edit_env_rep::exec_until_table (tree t, path p, string var, int level) {
02022   tree oldv= read (CELL_FORMAT);
02023   // should execute values in oldv
02024   monitored_write_update (CELL_FORMAT, tree (TFORMAT));
02025   int i, n= N(t);
02026   for (i=0; i<n; i++)
02027     if (exec_until (t[i], p, var, level))
02028       return true;
02029   monitored_write_update (CELL_FORMAT, oldv);
02030   return false;
02031 }
02032 
02033 bool
02034 edit_env_rep::exec_until_with (tree t, path p, string var, int level) {
02035   int i, n= N(t), k= (n-1)>>1; // is k=0 allowed ?
02036   if ((n&1) != 1) return false;
02037   STACK_NEW_ARRAY(vars,string,k);
02038   STACK_NEW_ARRAY(oldv,tree,k);
02039   STACK_NEW_ARRAY(newv,tree,k);
02040   for (i=0; i<k; i++) {
02041     tree var_t= exec (t[i<<1]);
02042     if (is_atomic (var_t)) {
02043       string var= var_t->label;
02044       vars[i]= var;
02045       oldv[i]= read (var);
02046       newv[i]= exec (t[(i<<1)+1]);
02047     }
02048     else {
02049       STACK_DELETE_ARRAY(vars);
02050       STACK_DELETE_ARRAY(oldv);
02051       STACK_DELETE_ARRAY(newv);
02052       return false;
02053     }
02054   }
02055 
02056   for (i=0; i<k; i++) monitored_write_update (vars[i], newv[i]);
02057   if (exec_until (t[n-1], p, var, level)) {
02058     STACK_DELETE_ARRAY(vars);
02059     STACK_DELETE_ARRAY(oldv);
02060     STACK_DELETE_ARRAY(newv);
02061     return true;
02062   }
02063   for (i=k-1; i>=0; i--) write_update (vars[i], oldv[i]);
02064   STACK_DELETE_ARRAY(vars);
02065   STACK_DELETE_ARRAY(oldv);
02066   STACK_DELETE_ARRAY(newv);
02067   return false;
02068 }
02069 
02070 bool
02071 edit_env_rep::exec_until_compound (tree t, path p, string var, int level) {
02072   int d; tree f;
02073   if (L(t) == COMPOUND) {
02074     d= 1;
02075     f= t[0];
02076     if (is_compound (f)) f= exec (f);
02077     if (is_atomic (f)) {
02078       string var= f->label;
02079       if (!provides (var)) return false;
02080       f= read (var);
02081     }
02082   }
02083   else {
02084     string fname= as_string (L(t));
02085     if (!provides (fname)) return false;
02086     d= 0;
02087     f= read (fname);
02088   }
02089 
02090   if (is_applicable (f)) {
02091     int i, n=N(f)-1, m=N(t)-d;
02092     macro_arg= list<hashmap<string,tree> >
02093       (hashmap<string,tree> (UNINIT), macro_arg);
02094     macro_src= list<hashmap<string,path> >
02095       (hashmap<string,path> (path (DECORATION)), macro_src);
02096     if (L(f) == XMACRO) {
02097       if (is_atomic (f[0]))
02098        macro_arg->item (f[0]->label)= t;
02099     }
02100     for (i=0; i<n; i++)
02101       if (is_atomic (f[i])) {
02102        tree st= i<m? t[i+d]: tree (UNINIT);
02103        macro_arg->item (f[i]->label)= st;
02104        macro_src->item (f[i]->label)= obtain_ip (st);
02105       }
02106     bool done= exec_until (f[n], p, var, level+1);
02107     macro_arg= macro_arg->next;
02108     macro_src= macro_src->next;
02109     return done;
02110   }
02111   return false;
02112 }
02113 
02114 bool
02115 edit_env_rep::exec_until_arg (tree t, path p, string var, int level) {
02116   // cout << "  " << macro_arg << "\n";
02117   tree r= t[0];
02118   if (is_atomic (r) && (!is_nil (macro_arg)) &&
02119       macro_arg->item->contains (r->label))
02120     {
02121       bool found;
02122       tree arg= macro_arg->item [r->label];
02123       list<hashmap<string,tree> > old_var= macro_arg;
02124       list<hashmap<string,path> > old_src= macro_src;
02125       if (!is_nil (macro_arg)) macro_arg= macro_arg->next;
02126       if (!is_nil (macro_src)) macro_src= macro_src->next;
02127       if (level == 0) {
02128        found= (r->label == var);
02129        if ((N(t) > 1) && found) {
02130          int i, n= N(t);
02131          for (i=1; i<n; i++) {
02132            tree u= exec (t[i]);
02133            if (!is_int (u)) { found= false; break; }
02134            int nr= as_int (u);
02135            if ((!is_compound (arg)) || (nr<0) || (nr>=N(arg)) || is_nil (p)) {
02136              found= false; break; }
02137            if (p->item != nr) found= false;
02138            arg= arg[nr];
02139            p  = p->next;
02140          }
02141        }
02142        if (found) exec_until (arg, p);
02143        else exec (arg);
02144       }
02145       else found= exec_until (arg, p, var, level-1);
02146       macro_arg= old_var;
02147       macro_src= old_src;
02148       return found;
02149     }
02150   else return false;
02151   /*
02152   cout << "  " << macro_arg << "\n";
02153   tree r= t[0];
02154   if (is_atomic (r) && (r->label == var) && (!is_nil (macro_arg))) {
02155     bool found= (level == 0) && macro_arg->item->contains (r->label);
02156     tree arg  = macro_arg->item [var];
02157     list<hashmap<string,tree> > old_var= macro_arg;
02158     list<hashmap<string,path> > old_src= macro_src;
02159     if (!is_nil (macro_arg)) macro_arg= macro_arg->next;
02160     if (!is_nil (macro_src)) macro_src= macro_src->next;
02161     if (found) exec_until (arg, p);
02162     else found= exec_until (arg, p, var, level-1);
02163     macro_arg= old_var;
02164     macro_src= old_src;
02165     return found;
02166   }
02167   */
02168 }
02169 
02170 bool
02171 edit_env_rep::exec_until_mark (tree t, path p, string var, int level) {
02172   bool border= false;
02173   if ((level == 0) && is_func (t[0], ARG) && (t[0][0] == var)) {
02174     // cout << "\n\tTest: " << t[0] << ", " << p << "\n";
02175     path q= p;
02176     int i, n= N(t[0]);
02177     for (i=1; (!is_nil (q)) && (i<n); i++, q= q->next)
02178       if (t[0][i] != as_string (q->item))
02179        break;
02180     border= (i == n) && is_atom (q);
02181     // FIXME: in order to be clean, we should check whether q->item
02182     // is on the border of the contents of the argument t[0].
02183     // Nevertheless, this only matters for strings and
02184     // the present implementation seems to be OK for the moment.
02185     // cout << "\tBorder= " << border << "\n\n";
02186   }
02187   if (border) return exec_until (t[0], p, var, level);
02188   else return exec_until (t[1], p, var, level);
02189 }
02190 
02191 bool
02192 edit_env_rep::exec_until_quasi (tree t, path p, string var, int level) {
02193   bool old= quote_substitute;
02194   quote_substitute= true;
02195   tree u= exec_quasiquoted (t[0]);
02196   quote_substitute= old;
02197   return exec_until (u, p, var, level);
02198 }
02199 
02200 bool
02201 edit_env_rep::exec_until_if (tree t, path p, string var, int level) {
02202   if ((N(t)!=2) && (N(t)!=3)) return false;
02203   tree tt= exec (t[0]);
02204   if (is_compound (tt) || !is_bool (tt->label)) return false;
02205   if (as_bool (tt->label)) return exec_until (t[1], p, var, level);
02206   if (N(t)==3) return exec_until (t[2], p, var, level);
02207   return false;
02208 }
02209 
02210 bool
02211 edit_env_rep::exec_until_case (tree t, path p, string var, int level) {
02212   if (N(t)<2) return false;
02213   int i, n= N(t);
02214   for (i=0; i<(n-1); i+=2) {
02215     tree tt= exec (t[i]);
02216     if (is_compound (tt) || ! is_bool (tt->label)) return false;
02217     if (as_bool (tt->label)) return exec_until (t[i+1], p, var, level);
02218   }
02219   if (i<n) return exec_until (t[i], p, var, level);
02220   return false;
02221 }
02222 
02223 bool
02224 edit_env_rep::exec_until_while (tree t, path p, string var, int level) {
02225   if (N(t)!=2) return false;
02226   while (1) {
02227     tree tt= exec (t[0]);
02228     if (is_compound (tt)) return false;
02229     if (!is_bool (tt->label)) return false;
02230     if (!as_bool (tt->label)) break;
02231     if (exec_until (t[1], p, var, level)) return true;
02232   }
02233   return false;
02234 }
02235 
02236 /******************************************************************************
02237 * Extra routines for macro expansion and function application
02238 ******************************************************************************/
02239 
02240 tree
02241 edit_env_rep::expand (tree t, bool search_accessible) {
02242   if (is_atomic (t) || is_nil (macro_arg)) return t;
02243   else if (is_func (t, ARG) || is_func (t, QUOTE_ARG)) {
02244     if (N(t) < 1)
02245       return tree (ERROR, "bad argument application");
02246     if (is_compound (t[0]))
02247       return tree (ERROR, "bad argument application");
02248     if (!macro_arg->item->contains (t[0]->label))
02249       return tree (ERROR, "argument " * t[0]->label);
02250     tree r= macro_arg->item [t[0]->label];
02251     list<hashmap<string,tree> > old_var= macro_arg;
02252     list<hashmap<string,path> > old_src= macro_src;
02253     if (!is_nil (macro_arg)) macro_arg= macro_arg->next;
02254     if (!is_nil (macro_src)) macro_src= macro_src->next;
02255     if (N(t) > 1) {
02256       int i, n= N(t);
02257       for (i=1; i<n; i++) {
02258        tree u= exec (t[i]);
02259        if (!is_int (u)) break;
02260        int nr= as_int (u);
02261        if ((!is_compound (r)) || (nr<0) || (nr>=N(r))) break;
02262        r= r[nr];
02263       }
02264     }
02265     if (is_func (t, ARG))
02266       r= expand (r, search_accessible);
02267     macro_arg= old_var;
02268     macro_src= old_src;
02269     return r;
02270   }
02271   else if (is_func (t, EXPAND_AS, 2)) {
02272     if (N(t) < 1)
02273       return tree (ERROR, "bad argument application");
02274     return expand (t[0], search_accessible);
02275   } else if (search_accessible && is_accessible (obtain_ip (t)))
02276     return t;
02277   else {
02278     int i, n= N(t);
02279     tree r (t, n);
02280     for (i=0; i<n; i++) {
02281       r[i]= expand (t[i], search_accessible);
02282       if (search_accessible &&
02283          is_accessible (obtain_ip (r[i])) &&
02284          drd->is_accessible_child (t, i))
02285        return r[i];
02286     }
02287     if (search_accessible) return t;
02288     return r;
02289   }
02290 }
02291 
02292 bool
02293 edit_env_rep::depends (tree t, string s, int level) {
02294   /*
02295   cout << "Depends? " << t << ", " << s << ", " << level
02296        << " " << macro_arg << "\n";
02297   */
02298 
02299   if (is_atomic (t) || is_nil (macro_arg)) return false;
02300   else if (is_func (t, ARG) ||
02301           is_func (t, QUOTE_ARG) ||
02302           is_func (t, MAP_ARGS) ||
02303           is_func (t, EVAL_ARGS))
02304     {
02305       // FIXME: this does not handle more complex dependencies,
02306       // like those encountered after rewritings (INCLUDE, EXTERN, etc.)
02307       tree v= (L(t) == MAP_ARGS? t[2]: t[0]);
02308       if (is_compound (v)) return false;
02309       if (!macro_arg->item->contains (v->label)) return false;
02310       if (level == 0) return v->label == s;
02311       tree r= macro_arg->item [v->label];
02312       list<hashmap<string,tree> > old_var= macro_arg;
02313       list<hashmap<string,path> > old_src= macro_src;
02314       if (!is_nil (macro_arg)) macro_arg= macro_arg->next;
02315       if (!is_nil (macro_src)) macro_src= macro_src->next;
02316       bool dep= depends (r, s, level-1);
02317       macro_arg= old_var;
02318       macro_src= old_src;
02319       return dep;
02320     }
02321   else {
02322     int i, n= N(t);
02323     for (i=0; i<n; i++)
02324       if (depends (t[i], s, level))
02325        return true;
02326     return false;
02327   }
02328 }