/TeXmacs-1.0.7.11-src/src/Style/Evaluate/evaluate_textual.cpp

  1
  2/******************************************************************************
  3* MODULE     : evaluate_textual.cpp
  4* DESCRIPTION: operations on text (strings, tuples and trees)
  5* COPYRIGHT  : (C) 2006  Joris van der Hoeven
  6*******************************************************************************
  7* This software falls under the GNU general public license version 3 or later.
  8* It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
  9* in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
 10******************************************************************************/
 11
 12#include "evaluate_main.hpp"
 13#include "analyze.hpp"
 14#include "vars.hpp"
 15#include "language.hpp"
 16#include "gui.hpp"
 17#include "file.hpp"
 18#include "dictionary.hpp"
 19
 20/******************************************************************************
 21* Array-like operations on strings and compound structures
 22******************************************************************************/
 23
 24tree
 25evaluate_merge (tree t) {
 26  int i, n= N(t);
 27  if (n == 0) return "";
 28  tree acc= evaluate (t[0]);
 29  if (is_concat (acc)) acc= tree_as_string (acc);
 30  for (i=1; i<n; i++) {
 31    tree add= evaluate (t[i]);
 32    if (is_atomic (acc) && (is_atomic (add) || is_concat (add)))
 33      acc= acc->label * tree_as_string (add);
 34    else if (is_tuple (acc) && is_tuple (add))
 35      acc= acc * add;
 36    else if (is_func (acc, MACRO) && is_func (add, MACRO) &&
 37	     (N(acc) == N(add)) &&
 38	     (acc (0, N(acc)-1) == add (0, N(add)-1)))
 39      {
 40	tree r = copy (acc);
 41	tree u1= copy (acc[N(acc)-1]);
 42	tree u2= copy (add[N(add)-1]);
 43	tree u (CONCAT, u1, u2);
 44	if (u1 == "") u= u2;
 45	else if (u2 == "") u= u1;
 46	else if (is_atomic (u1) && is_atomic (u2))
 47	  u= u1->label * u2->label;
 48	r[N(r)-1]= u;
 49	acc= r;
 50      }
 51    else return evaluate_error ("bad merge");
 52  }
 53  return acc;
 54}
 55
 56tree
 57evaluate_length (tree t) {
 58  if (N(t)!=1) return evaluate_error ("bad length");
 59  tree t1= evaluate (t[0]);
 60  if (is_compound (t1)) {
 61    if (is_tuple (t1)) return as_string (N (t1));
 62    return evaluate_error ("bad length");
 63  }
 64  return as_string (N (t1->label));
 65}
 66
 67tree
 68evaluate_range (tree t) {
 69  if (N(t)!=3) return evaluate_error ("bad range");
 70  tree t1= evaluate (t[0]);
 71  tree t2= evaluate (t[1]);
 72  tree t3= evaluate (t[2]);
 73  if (!(is_int (t2) && is_int (t3))) return evaluate_error ("bad range");
 74  if (is_compound (t1)) {
 75    if (is_tuple (t1)) {
 76      int i1= max (0, as_int (t2));
 77      int i2= min (N (t1), as_int (t3));
 78      i2 = max (i1, i2);
 79      return t1 (i1, i2);
 80    }
 81    return evaluate_error ("bad range");
 82  }
 83  int i1= max (0, as_int (t2));
 84  int i2= min (N(t1->label), as_int (t3));
 85  i2 = max (i1, i2);
 86  return t1->label (i1, i2);
 87}
 88
 89/******************************************************************************
 90* Routines on strings
 91******************************************************************************/
 92
 93tree
 94evaluate_number (tree t) {
 95  if (N(t)!=2) return evaluate_error ("bad number");
 96  tree t1= evaluate (t[0]);
 97  tree t2= evaluate (t[1]);
 98  if (is_compound (t1) || is_compound (t2))
 99    return evaluate_error ("bad number");
100  string s1= t1->label;
101  string s2= t2->label;
102  int nr= as_int (s1);
103  if (s2 == "roman") return roman_nr (nr);
104  if (s2 == "Roman") return Roman_nr (nr);
105  if (s2 == "alpha") return alpha_nr (nr);
106  if (s2 == "Alpha") return Alpha_nr (nr);
107  if (s2 == "fnsymbol")
108    return tree (WITH, MODE, "math", tree (RIGID, fnsymbol_nr (nr)));
109  return evaluate_error ("bad number");
110}
111
112tree
113evaluate_date (tree t) {
114  if (N(t)>2) return evaluate_error ("bad date");
115  string lan= as_string (std_env [LANGUAGE]);
116  if (N(t) == 2) {
117    tree u= evaluate (t[1]);
118    if (is_compound (u)) return evaluate_error ("bad date");
119    lan= u->label;
120  }
121  string fm= "";
122  if (N(t) != 0) {
123    tree u= evaluate (t[0]);
124    if (is_compound (u)) return evaluate_error ("bad date");
125    fm= u->label;
126  }
127  return get_date (lan, fm);
128}
129
130tree
131evaluate_translate (tree t) {
132  if (N(t)!=3) return evaluate_error ("bad translate");
133  tree t1= evaluate (t[0]);
134  tree t2= evaluate (t[1]);
135  tree t3= evaluate (t[2]);
136  if (is_compound (t1) || is_compound (t2) || is_compound (t3))
137    return evaluate_error ("bad translate");
138  return translate (t1->label, t2->label, t3->label);
139}
140
141tree
142evaluate_change_case (tree t, tree nc, bool evaluate_flag, bool first) {
143  if (is_atomic (t)) {
144    string s= t->label;
145    tree   r= copy (s);
146    int i, n= N(s);
147
148    bool all= true;
149    bool up = false;
150    bool lo = false;
151    if (nc == "Upcase") { all= false; up= true; }
152    else if (nc == "UPCASE") { up= true; }
153    else if (nc == "locase") { lo= true; }
154
155    for (i=0; i<n; tm_char_forwards (s, i))
156      if (is_iso_alpha (s[i]) && (all || (first && (i==0)))) {
157	if (up && is_locase (s[i])) r->label[i]= upcase (s[i]);
158	if (lo && is_upcase (s[i])) r->label[i]= locase (s[i]);
159      }
160    r->obs= list_observer (ip_observer (obtain_ip (t)), r->obs);
161    return r;
162  }
163  else if (is_concat (t)) {
164    int i, n= N(t);
165    tree r (t, n);
166    for (i=0; i<n; i++)
167      r[i]= evaluate_change_case (t[i], nc, evaluate_flag, first && (i==0));
168    r->obs= list_observer (ip_observer (obtain_ip (t)), r->obs);
169    return r;
170  }
171  else {
172    if (evaluate_flag) return t;
173    else return evaluate_change_case (evaluate (t), nc, true, first);
174  }
175}
176
177tree
178evaluate_change_case (tree t) {
179  if (N(t) < 2) return evaluate_error ("bad change case");
180  return evaluate_change_case (t[0], evaluate (t[1]), false, true);
181}
182
183tree
184evaluate_find_file (tree t) {
185  int i, n=N(t);
186  array<tree> r (n);
187  for (i=0; i<n; i++) {
188    r[i]= evaluate (t[i]);
189    if (is_compound (r[i]))
190      return evaluate_error ("bad find file");
191  }
192  for (i=0; i<(n-1); i++) {
193    url u= resolve (url (r[i]->label, r[n-1]->label));
194    if (!is_none (u)) {
195      if (is_rooted (u, "default")) u= reroot (u, "file");
196      return as_string (u);
197    }
198  }
199  url base_file_name (as_string (std_env["base-file-name"]));
200  url u= resolve (base_file_name * url_parent () * r[n-1]->label);
201  if (!is_none (u)) {
202    if (is_rooted (u, "default")) u= reroot (u, "file");
203    return as_string (u);
204  }
205  return "false";
206}
207
208/******************************************************************************
209* Routines on tuples
210******************************************************************************/
211
212tree
213evaluate_is_tuple (tree t) {
214  if (N(t)!=1) return evaluate_error ("bad tuple query");
215  return as_string_bool(is_tuple (evaluate (t[0])));
216}
217
218tree
219evaluate_lookup (tree t) {
220  if (N(t)!=2) return evaluate_error ("bad look up");
221  tree t1= evaluate (t[0]);
222  tree t2= evaluate (t[1]);
223  if (!(is_compound (t1) && is_int (t2)))
224    return evaluate_error ("bad look up");
225  int i= as_int (t2);
226  if (i < 0 || i >= N(t1))
227    return evaluate_error ("index out of range in look up");
228  return t1[i];
229}