Back to index

texmacs  1.0.7.15
evaluate_textual.cpp
Go to the documentation of this file.
00001 
00002 /******************************************************************************
00003 * MODULE     : evaluate_textual.cpp
00004 * DESCRIPTION: operations on text (strings, tuples and trees)
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 "analyze.hpp"
00014 #include "vars.hpp"
00015 #include "language.hpp"
00016 #include "gui.hpp"
00017 #include "file.hpp"
00018 #include "dictionary.hpp"
00019 
00020 /******************************************************************************
00021 * Array-like operations on strings and compound structures
00022 ******************************************************************************/
00023 
00024 tree
00025 evaluate_merge (tree t) {
00026   int i, n= N(t);
00027   if (n == 0) return "";
00028   tree acc= evaluate (t[0]);
00029   if (is_concat (acc)) acc= tree_as_string (acc);
00030   for (i=1; i<n; i++) {
00031     tree add= evaluate (t[i]);
00032     if (is_atomic (acc) && (is_atomic (add) || is_concat (add)))
00033       acc= acc->label * tree_as_string (add);
00034     else if (is_tuple (acc) && is_tuple (add))
00035       acc= acc * add;
00036     else if (is_func (acc, MACRO) && is_func (add, MACRO) &&
00037             (N(acc) == N(add)) &&
00038             (acc (0, N(acc)-1) == add (0, N(add)-1)))
00039       {
00040        tree r = copy (acc);
00041        tree u1= copy (acc[N(acc)-1]);
00042        tree u2= copy (add[N(add)-1]);
00043        tree u (CONCAT, u1, u2);
00044        if (u1 == "") u= u2;
00045        else if (u2 == "") u= u1;
00046        else if (is_atomic (u1) && is_atomic (u2))
00047          u= u1->label * u2->label;
00048        r[N(r)-1]= u;
00049        acc= r;
00050       }
00051     else return evaluate_error ("bad merge");
00052   }
00053   return acc;
00054 }
00055 
00056 tree
00057 evaluate_length (tree t) {
00058   if (N(t)!=1) return evaluate_error ("bad length");
00059   tree t1= evaluate (t[0]);
00060   if (is_compound (t1)) {
00061     if (is_tuple (t1)) return as_string (N (t1));
00062     return evaluate_error ("bad length");
00063   }
00064   return as_string (N (t1->label));
00065 }
00066 
00067 tree
00068 evaluate_range (tree t) {
00069   if (N(t)!=3) return evaluate_error ("bad range");
00070   tree t1= evaluate (t[0]);
00071   tree t2= evaluate (t[1]);
00072   tree t3= evaluate (t[2]);
00073   if (!(is_int (t2) && is_int (t3))) return evaluate_error ("bad range");
00074   if (is_compound (t1)) {
00075     if (is_tuple (t1)) {
00076       int i1= max (0, as_int (t2));
00077       int i2= min (N (t1), as_int (t3));
00078       i2 = max (i1, i2);
00079       return t1 (i1, i2);
00080     }
00081     return evaluate_error ("bad range");
00082   }
00083   int i1= max (0, as_int (t2));
00084   int i2= min (N(t1->label), as_int (t3));
00085   i2 = max (i1, i2);
00086   return t1->label (i1, i2);
00087 }
00088 
00089 /******************************************************************************
00090 * Routines on strings
00091 ******************************************************************************/
00092 
00093 tree
00094 evaluate_number (tree t) {
00095   if (N(t)!=2) return evaluate_error ("bad number");
00096   tree t1= evaluate (t[0]);
00097   tree t2= evaluate (t[1]);
00098   if (is_compound (t1) || is_compound (t2))
00099     return evaluate_error ("bad number");
00100   string s1= t1->label;
00101   string s2= t2->label;
00102   int nr= as_int (s1);
00103   if (s2 == "roman") return roman_nr (nr);
00104   if (s2 == "Roman") return Roman_nr (nr);
00105   if (s2 == "alpha") return alpha_nr (nr);
00106   if (s2 == "Alpha") return Alpha_nr (nr);
00107   if (s2 == "fnsymbol")
00108     return tree (WITH, MODE, "math", tree (RIGID, fnsymbol_nr (nr)));
00109   return evaluate_error ("bad number");
00110 }
00111 
00112 tree
00113 evaluate_date (tree t) {
00114   if (N(t)>2) return evaluate_error ("bad date");
00115   string lan= as_string (std_env [LANGUAGE]);
00116   if (N(t) == 2) {
00117     tree u= evaluate (t[1]);
00118     if (is_compound (u)) return evaluate_error ("bad date");
00119     lan= u->label;
00120   }
00121   string fm= "";
00122   if (N(t) != 0) {
00123     tree u= evaluate (t[0]);
00124     if (is_compound (u)) return evaluate_error ("bad date");
00125     fm= u->label;
00126   }
00127   return get_date (lan, fm);
00128 }
00129 
00130 tree
00131 evaluate_translate (tree t) {
00132   if (N(t)!=3) return evaluate_error ("bad translate");
00133   tree t1= evaluate (t[0]);
00134   tree t2= evaluate (t[1]);
00135   tree t3= evaluate (t[2]);
00136   if (is_compound (t1) || is_compound (t2) || is_compound (t3))
00137     return evaluate_error ("bad translate");
00138   return translate (t1->label, t2->label, t3->label);
00139 }
00140 
00141 tree
00142 evaluate_change_case (tree t, tree nc, bool evaluate_flag, bool first) {
00143   if (is_atomic (t)) {
00144     string s= t->label;
00145     tree   r= copy (s);
00146     int i, n= N(s);
00147 
00148     bool all= true;
00149     bool up = false;
00150     bool lo = false;
00151     if (nc == "Upcase") { all= false; up= true; }
00152     else if (nc == "UPCASE") { up= true; }
00153     else if (nc == "locase") { lo= true; }
00154 
00155     for (i=0; i<n; tm_char_forwards (s, i))
00156       if (is_iso_alpha (s[i]) && (all || (first && (i==0)))) {
00157        if (up && is_locase (s[i])) r->label[i]= upcase (s[i]);
00158        if (lo && is_upcase (s[i])) r->label[i]= locase (s[i]);
00159       }
00160     r->obs= list_observer (ip_observer (obtain_ip (t)), r->obs);
00161     return r;
00162   }
00163   else if (is_concat (t)) {
00164     int i, n= N(t);
00165     tree r (t, n);
00166     for (i=0; i<n; i++)
00167       r[i]= evaluate_change_case (t[i], nc, evaluate_flag, first && (i==0));
00168     r->obs= list_observer (ip_observer (obtain_ip (t)), r->obs);
00169     return r;
00170   }
00171   else {
00172     if (evaluate_flag) return t;
00173     else return evaluate_change_case (evaluate (t), nc, true, first);
00174   }
00175 }
00176 
00177 tree
00178 evaluate_change_case (tree t) {
00179   if (N(t) < 2) return evaluate_error ("bad change case");
00180   return evaluate_change_case (t[0], evaluate (t[1]), false, true);
00181 }
00182 
00183 tree
00184 evaluate_find_file (tree t) {
00185   int i, n=N(t);
00186   array<tree> r (n);
00187   for (i=0; i<n; i++) {
00188     r[i]= evaluate (t[i]);
00189     if (is_compound (r[i]))
00190       return evaluate_error ("bad find file");
00191   }
00192   for (i=0; i<(n-1); i++) {
00193     url u= resolve (url (r[i]->label, r[n-1]->label));
00194     if (!is_none (u)) {
00195       if (is_rooted (u, "default")) u= reroot (u, "file");
00196       return as_string (u);
00197     }
00198   }
00199   url base_file_name (as_string (std_env["base-file-name"]));
00200   url u= resolve (base_file_name * url_parent () * r[n-1]->label);
00201   if (!is_none (u)) {
00202     if (is_rooted (u, "default")) u= reroot (u, "file");
00203     return as_string (u);
00204   }
00205   return "false";
00206 }
00207 
00208 /******************************************************************************
00209 * Routines on tuples
00210 ******************************************************************************/
00211 
00212 tree
00213 evaluate_is_tuple (tree t) {
00214   if (N(t)!=1) return evaluate_error ("bad tuple query");
00215   return as_string_bool(is_tuple (evaluate (t[0])));
00216 }
00217 
00218 tree
00219 evaluate_lookup (tree t) {
00220   if (N(t)!=2) return evaluate_error ("bad look up");
00221   tree t1= evaluate (t[0]);
00222   tree t2= evaluate (t[1]);
00223   if (!(is_compound (t1) && is_int (t2)))
00224     return evaluate_error ("bad look up");
00225   int i= as_int (t2);
00226   if (i < 0 || i >= N(t1))
00227     return evaluate_error ("index out of range in look up");
00228   return t1[i];
00229 }