Back to index

texmacs  1.0.7.15
evaluate_control.cpp
Go to the documentation of this file.
00001 
00002 /******************************************************************************
00003 * MODULE     : evaluate_control.cpp
00004 * DESCRIPTION: control structures
00005 * COPYRIGHT  : (C) 2006  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 "evaluate_main.hpp"
00013 #include "std_environment.hpp"
00014 #include "vars.hpp"
00015 #include "file.hpp"
00016 #include "convert.hpp"
00017 #include "scheme.hpp"
00018 
00019 tree load_inclusion (url u); // implemented in tm_file.cpp
00020 
00021 /******************************************************************************
00022 * Classical control structures
00023 ******************************************************************************/
00024 
00025 tree
00026 evaluate_if (tree t) {
00027   if (N(t) != 2 && N(t) != 3) return evaluate_error ("bad if");
00028   tree u= evaluate (t[0]);
00029   if (!is_bool (u)) return evaluate_error ("bad if");
00030   if (as_bool (u)) return evaluate (t[1]);
00031   if (N(t)==3) return evaluate (t[2]);
00032   return "";
00033 }
00034 
00035 tree
00036 evaluate_case (tree t) {
00037   if (N(t) < 2) return evaluate_error ("bad case");
00038   int i, n= N(t);
00039   for (i=0; i<(n-1); i+=2) {
00040     tree u= evaluate (t[i]);
00041     if (!is_bool (u)) return evaluate_error ("bad case");
00042     if (as_bool (u)) return evaluate (t[i+1]);
00043   }
00044   if (i<n) return evaluate (t[i]);
00045   return "";
00046 }
00047 
00048 tree
00049 evaluate_while (tree t) {
00050   if (N(t) != 2) return evaluate_error ("bad while");
00051   tree r (CONCAT);
00052   while (true) {
00053     tree u= evaluate (t[0]);
00054     if (!is_bool (u)) return evaluate_error ("bad while");
00055     if (!as_bool (u)) break;
00056     r << evaluate (t[1]);
00057   }
00058   if (N(r) == 0) return "";
00059   if (N(r) == 1) return r[0];
00060   return r;
00061 }
00062 
00063 tree
00064 evaluate_for_each (tree t) {
00065   if (N(t) != 2) return evaluate_error ("bad for-each");
00066   tree fun = evaluate (t[0]);
00067   tree args= evaluate (t[1]);
00068   if (!is_tuple (args)) return evaluate_error ("bad for-each");
00069   int i, n= N(args);
00070   for (i=0; i<n; i++)
00071     evaluate (tree (COMPOUND, fun, args[i]));
00072   return "";
00073 }
00074 
00075 /******************************************************************************
00076 * External dependencies
00077 ******************************************************************************/
00078 
00079 tree
00080 evaluate_include (tree t) {
00081   url base_file_name (as_string (std_env["base-file-name"]));
00082   url incl_file_name= url_system (as_string (evaluate (t[0])));
00083   tree incl= load_inclusion (incl_file_name);
00084 
00085   assoc_environment local (2);
00086   local->raw_write (0, string ("cur-file-name"),
00087                   as_string (incl_file_name));
00088   local->raw_write (1, string ("secure"),
00089                   bool_as_tree (is_secure (incl_file_name)));
00090 
00091   begin_with (std_env, local);
00092   tree r= evaluate (incl);
00093   end_with (std_env);
00094   return r;
00095 }
00096 
00097 static tree
00098 filter_style (tree t) {
00099   if (is_atomic (t)) return t;
00100   else switch (L(t)) {
00101   case STYLE_WITH:
00102   case VAR_STYLE_WITH:
00103     return filter_style (t[N(t)-1]);
00104   case STYLE_ONLY:
00105   case VAR_STYLE_ONLY:
00106     if (is_atomic (t[0])) return "";
00107     else return filter_style (t[0][N(t[0])-1]);
00108   case ACTIVE:
00109   case VAR_ACTIVE:
00110   case INACTIVE:
00111   case VAR_INACTIVE:
00112     return filter_style (t[0]);
00113   default:
00114     {
00115       int i, n= N(t);
00116       tree r (t, n);
00117       for (i=0; i<n; i++)
00118        r[i]= filter_style (t[i]);
00119       return r;
00120     }
00121   }
00122 }
00123 
00124 tree
00125 evaluate_use_package (tree t) {
00126   int i, n= N(t);
00127   for (i=0; i<n; i++) {
00128     url base_file_name (as_string (std_env["base-file-name"]));
00129     url styp= "$TEXMACS_STYLE_PATH";
00130     url name= as_string (t[i]) * string (".ts");
00131     //cout << "Package " << name << "\n";
00132     if (is_rooted_web (base_file_name))
00133       styp= styp | head (base_file_name);
00134     else styp= head (base_file_name) | styp;
00135     string doc_s;
00136     if (!load_string (styp * name, doc_s, false)) {
00137       tree doc= texmacs_document_to_tree (doc_s);
00138       if (is_compound (doc))
00139        evaluate (filter_style (extract (doc, "body")));
00140     }
00141   }
00142   return "";
00143 }
00144 
00145 tree
00146 evaluate_use_module (tree t) {
00147   int i, n= N(t);
00148   for (i=0; i<n; i++) {
00149     string s= evaluate_string (t[i]);
00150     if (starts (s, "(")) eval ("(use-modules " * s * ")");
00151     else if (s != "") eval ("(plugin-initialize '" * s * ")");
00152     tree t= std_env[THE_MODULES] * tuple (s);
00153     assoc_environment local (1);
00154     local->raw_write (0, THE_MODULES, t);
00155     assign (std_env, local);
00156   }
00157   return "";
00158 }