00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include <basix/string.hpp>
00014 #include <basix/table.hpp>
00015 #include <basix/literal.hpp>
00016 #include <basix/compound.hpp>
00017 #include <basix/row_tuple.hpp>
00018 #include <basix/lisp_syntax.hpp>
00019 namespace mmx {
00020
00021 #define DATA_BEGIN ((char) 2)
00022 #define DATA_END ((char) 5)
00023 #define DATA_ESCAPE ((char) 27)
00024 #define DATA_COMMAND '\20'
00025
00026 generic print_mmx (const generic& g);
00027 string as_texmacs_snippet (const generic& g);
00028
00029
00030
00031
00032
00033 static string texmacs_pending= "";
00034
00035 void
00036 texmacs_command (const string& cmd) {
00037 texmacs_pending << " " << cmd << "\n";
00038 }
00039
00040 string
00041 texmacs_flush_commands () {
00042 if (texmacs_pending == "") return "";
00043 string s=
00044 string (DATA_BEGIN) *
00045 "command:(begin" * texmacs_pending * ")" *
00046 string (DATA_END);
00047 texmacs_pending= "";
00048 return s;
00049 }
00050
00051 void
00052 texmacs_dynamic_event (const string& id, const generic& val) {
00053 string v= as_texmacs_snippet (as_generic (flatten (val)));
00054 texmacs_command ("(locus-set \"" * id * "\" '" * v * ")");
00055 mmout << texmacs_flush_commands ();
00056 }
00057
00058
00059
00060
00061
00062 generic add_modes (const generic& g, int mode);
00063
00064 generic
00065 add_modes (const generic& g, int mode, int new_mode) {
00066
00067 generic r= add_modes (g, new_mode);
00068 if (is_func (r, "$concat", 1)) r= r[1];
00069 if (mode == new_mode) return r;
00070 else if (is_func (r, "$math", 1)) return r;
00071 else if (is_func (r, "$text", 1)) return r;
00072 else if (new_mode == 1) return gen ("$math", r);
00073 else if (new_mode == 2) return gen ("$text", r);
00074 else return r;
00075 }
00076
00077 generic
00078 add_modes (const generic& g, int mode) {
00079
00080 if (!is<compound> (g) || !is<literal> (g[0])) return g;
00081 if (is_func (g, "$math", 1)) return add_modes (g[1], mode, 1);
00082 if (is_func (g, "$text", 1)) return add_modes (g[1], mode, 2);
00083 if (is_func (g, "$inmath", 1)) return add_modes (g[1], 1);
00084 if (is_func (g, "$intext", 1)) return add_modes (g[1], 2);
00085 vector<generic> v= copy (compound_to_vector (g));
00086 for (nat i=1; i<N(v); i++) v[i]= add_modes (v[i], mode);
00087 return vector_to_compound (v);
00088 }
00089
00090
00091
00092
00093
00094 static void
00095 init (table<generic,generic>& t, const generic& key, const generic& val) {
00096 t[key]= val;
00097 }
00098
00099 static table<generic,generic>
00100 texmacs_symbol_table () {
00101 table<generic,generic> t;
00102
00103 init (t, "/\\", "tm$wedge");
00104 init (t, "mathcatalan", "tm$mathcatalan");
00105 init (t, "@", "tm$circ");
00106 init (t, "><", "tm$join");
00107 init (t, "derivative", "D");
00108 init (t, "mathe", "tm$mathe");
00109 init (t, "<=>", "tm$Leftrightarrow");
00110 init (t, "matheuler", "tm$matheuler");
00111 init (t, ">", "tm$gtr");
00112 init (t, ">=", "tm$geqslant");
00113 init (t, ">>", "tm$gg");
00114 init (t, "mathi", "tm$mathi");
00115 init (t, "=>", "tm$Rightarrow");
00116 init (t, "Infty", "tm$infty");
00117 init (t, "->", "tm$rightarrow");
00118 init (t, "<", "tm$less");
00119 init (t, "<=", "tm$leqslant");
00120 init (t, "<<", "tm$ll");
00121 init (t, ":->", "tm$mapsto");
00122 init (t, ".!", "!");
00123 init (t, "!", "tm$neg");
00124 init (t, "\\/", "tm$vee");
00125 init (t, "partial", "tm$partial");
00126 init (t, "mathpi", "tm$mathpi");
00127 init (t, ".'", "'");
00128 init (t, ".`", "`");
00129 init (t, "..", "tm$ldots");
00130 init (t, "::", "tm$colons");
00131 init (t, ":>", "tm$transtype");
00132 init (t, "!=", "tm$neq");
00133 init (t, "|", "|");
00134 init (t, "||", "tm$||");
00135 init (t, "xor", "tm$veebar");
00136 init (t, ":=", "tm$assign");
00137 init (t, "+=", "tm$plusassign");
00138 init (t, "-=", "tm$minusassign");
00139 init (t, "*=", "tm$astassign");
00140 init (t, "/=", "tm$overassign");
00141
00142 init (t, "alpha", "tm$alpha");
00143 init (t, "beta", "tm$beta");
00144 init (t, "gamma", "tm$gamma");
00145 init (t, "delta", "tm$delta");
00146 init (t, "epsilon", "tm$varepsilon");
00147 init (t, "zeta", "tm$zeta");
00148 init (t, "eta", "tm$eta");
00149 init (t, "theta", "tm$theta");
00150 init (t, "iota", "tm$iota");
00151 init (t, "kappa", "tm$kappa");
00152 init (t, "lambda", "tm$lambda");
00153 init (t, "mu", "tm$mu");
00154 init (t, "nu", "tm$nu");
00155 init (t, "xi", "tm$xi");
00156 init (t, "omicron", "tm$omicron");
00157 init (t, "pi", "tm$pi");
00158 init (t, "rho", "tm$rho");
00159 init (t, "sigma", "tm$sigma");
00160 init (t, "tau", "tm$tau");
00161 init (t, "upsilon", "tm$upsilon");
00162 init (t, "phi", "tm$varphi");
00163 init (t, "chi", "tm$chi");
00164 init (t, "psi", "tm$psi");
00165 init (t, "omega", "tm$omega");
00166
00167 init (t, "Alpha", "tm$Alpha");
00168 init (t, "Beta", "tm$Beta");
00169 init (t, "Gamma", "tm$Gamma");
00170 init (t, "Delta", "tm$Delta");
00171 init (t, "Epsilon", "tm$Epsilon");
00172 init (t, "Zeta", "tm$Zeta");
00173 init (t, "Eta", "tm$Eta");
00174 init (t, "Theta", "tm$Theta");
00175 init (t, "Iota", "tm$Iota");
00176 init (t, "Kappa", "tm$Kappa");
00177 init (t, "Lambda", "tm$Lambda");
00178 init (t, "Mu", "tm$Mu");
00179 init (t, "Nu", "tm$Nu");
00180 init (t, "Xi", "tm$Xi");
00181 init (t, "Omicron", "tm$Omicron");
00182 init (t, "Pi", "tm$Pi");
00183 init (t, "Rho", "tm$Rho");
00184 init (t, "Sigma", "tm$Sigma");
00185 init (t, "Tau", "tm$Tau");
00186 init (t, "Upsilon", "tm$Upsilon");
00187 init (t, "Phi", "tm$Phi");
00188 init (t, "Chi", "tm$Chi");
00189 init (t, "Psi", "tm$Psi");
00190 init (t, "Omega", "tm$Omega");
00191
00192 return t;
00193 }
00194
00195
00196
00197
00198
00199 bool
00200 is_infix (const generic& g, const generic& op) {
00201 return is_func (g, "$infix", 3) && g[2] == op;
00202 }
00203
00204 generic
00205 unbracket (const generic& g) {
00206 if (is_func (g, "$bracket", 3)) return g[2];
00207 else return g;
00208 }
00209
00210 bool
00211 is_alpha (const generic& g) {
00212 if (!is<literal> (g)) return false;
00213 string s= literal_to_string (g);
00214 for (nat i=0; i<N(s); i++)
00215 if ((s[i] < 'a' || s[i] > 'z') &&
00216 (s[i] < 'A' || s[i] > 'Z'))
00217 return false;
00218 return true;
00219 }
00220
00221 void
00222 concat_append (vector<generic>& v, const generic& g) {
00223 if (g == "");
00224 else if (is_func (g, "$concat")) {
00225 vector<generic> w= compound_to_vector (g);
00226 for (nat i=1; i<N(w); i++) concat_append (v, w[i]);
00227 }
00228 else if (N(v) == 0) v << g;
00229 else if (is<literal> (v[N(v)-1]) && is<literal> (g))
00230 v[N(v)-1]= generic (literal_to_string (v[N(v)-1]) * literal_to_string (g));
00231 else if (is_func (v[N(v)-1], "$lprime", 1) && is_func (g, "$lprime", 1)) {
00232 generic p (literal_to_string (v[N(v)-1][1]) * literal_to_string (g[1]));
00233 v[N(v)-1]= gen ("$lprime", p);
00234 }
00235 else if (is_func (v[N(v)-1], "$rprime", 1) && is_func (g, "$rprime", 1)) {
00236 generic p (literal_to_string (v[N(v)-1][1]) * literal_to_string (g[1]));
00237 v[N(v)-1]= gen ("$rprime", p);
00238 }
00239 else v << g;
00240 }
00241
00242 generic
00243 as_texmacs (const generic& g) {
00244 if (is<literal> (g)) {
00245 if (g == "$lf") return gen ("$lf");
00246 if (g == "$cr") return gen ("$cr");
00247 if (g == "$spc") return gen (" ");
00248 static table<generic,generic> t= texmacs_symbol_table ();
00249 generic h= g;
00250 if (contains (t, h)) h= t[h];
00251 if (!is<literal> (h)) return h;
00252 string s= literal_to_string (h);
00253 if (starts (s, "tm$"))
00254 return generic ("<" * s (3, N(s)) * ">");
00255 string r;
00256 for (nat i=0; i<N(s); i++)
00257 if (s[i] == '<') r << "<less>";
00258 else if (s[i] == '>') r << "<gtr>";
00259 else r << s[i];
00260 return r;
00261 }
00262 else if (is_func (g, "$concat")) {
00263 vector<generic> v;
00264 for (nat i=1; i<N(g); i++)
00265 concat_append (v, as_texmacs (g[i]));
00266 if (N(v) == 0) return generic ("");
00267 else if (N(v) == 1) return v[0];
00268 else return gen ("$concat", v);
00269 }
00270 else if (is_func (g, "$keyword", 1))
00271 return as_texmacs (gen ("$strong", g[1]));
00272 else if (is_func (g, "$keyword", 2))
00273 return as_texmacs (gen ("$concat", gen ("$strong", g[1]), "$spc", g[2]));
00274 else if (is_func (g, "$bracket", 3))
00275 return as_texmacs (gen ("$around*", g[1], g[2], g[3]));
00276 else if (is_func (g, "$prefix", 2)) {
00277 if (g[1] == "'" || g[1] == "`")
00278 return as_texmacs (gen ("$concat", gen ("$lprime", g[1]), g[2]));
00279 else return as_texmacs (gen ("$concat", g[1], g[2]));
00280 }
00281 else if (is_func (g, "$postfix", 2)) {
00282 if (g[2] == "'" || g[2] == "`")
00283 return as_texmacs (gen ("$concat", g[1], gen ("$lprime", g[2])));
00284 else return as_texmacs (gen ("$concat", g[1], g[2]));
00285 }
00286 else if (is_func (g, "$infix", 3)) {
00287 if (g[2] == "/")
00288 return as_texmacs (gen ("$frac", unbracket (g[1]), unbracket (g[3])));
00289 else if (g[2] == "^")
00290 return as_texmacs (gen ("$concat",
00291 g[1], gen ("$rsup", unbracket (g[3]))));
00292 else if (g[2] == "|" || g[2] == "||")
00293 return as_texmacs (gen ("$concat", g[1], gen ("$mid", g[2]), g[3]));
00294 else {
00295 generic op= as_texmacs (g[2]);
00296 if (is_alpha (op))
00297 op= gen ("$concat", "$spc", gen ("$strong", op), "$spc");
00298 return as_texmacs (gen ("$concat", g[1], g[2], g[3]));
00299 }
00300 }
00301 else if (is_func (g, "$bigop") && N(g) >= 3) {
00302 vector<generic> v;
00303 if (g[1] == GEN_PLUS && is_func (g[2], GEN_MINUS, 1))
00304 v << generic ("-") << g[2][1];
00305 else v << g[2];
00306 for (nat i=3; i<N(g); i++) {
00307 if (g[1] == GEN_PLUS && is_func (g[i], GEN_MINUS, 1))
00308 v << generic ("-") << g[i][1];
00309 else
00310 v << g[1] << g[i];
00311 }
00312 return as_texmacs (gen ("$concat", v));
00313 }
00314 else if (is_func (g, "$operate", 2)) {
00315 if (is_func (g[2], "$bracket", 3) && g[2][1] == "[")
00316 return as_texmacs (gen ("$concat",
00317 g[1], gen ("$rsub", unbracket (g[2]))));
00318 else return as_texmacs (gen ("$concat", g[1], g[2]));
00319 }
00320 else if (is_func (g, "$hlist")) {
00321 if (N(g) == 1) return generic ("");
00322 vector<generic> v= vec (g[1]);
00323 for (nat i=2; i<N(g); i++) v << generic (",") << g[i];
00324 return as_texmacs (gen ("$concat", v));
00325 }
00326 else if (is_func (g, "$vlist")) {
00327 vector<generic> v;
00328 for (nat i=1; i<N(g); i++)
00329 if (is_func (g[i], "$hlist"))
00330 v << gen ("$row", cdr (compound_to_vector (g[i])));
00331 if (N(v) == 0) return generic ("");
00332 return as_texmacs (gen ("$tabular*", gen ("$table", v)));
00333 }
00334 else if (is_func (g, "$indent")) {
00335 vector<generic> v;
00336 for (nat i=1; i<N(g); i++)
00337 concat_append (v, as_texmacs (g[i]));
00338 return gen ("$concat", gen ("$indent", gen ("$concat", v)), gen ("$lf"));
00339 }
00340 else if (is_func (g, "$text", 1))
00341 return gen ("$text", as_texmacs (g[1]));
00342 else if (is_func (g, "$math", 1))
00343 return gen ("$math", as_texmacs (g[1]));
00344 else if (is_func (g, "$dynamic"))
00345 return gen ("$locus", gen ("$id", as_texmacs (g[1])), as_texmacs (g[2]));
00346 else if (is<compound> (g)) {
00347 vector<generic> v;
00348 for (nat i=1; i<N(g); i++)
00349 v << as_texmacs (g[i]);
00350 return gen (g[0], v);
00351 }
00352 else ERROR ("not implemented");
00353 }
00354
00355
00356
00357
00358
00359 generic
00360 replace_lf (const generic& g) {
00361 if (is<literal> (g)) return g;
00362 else if (is_func (g, "$concat")) {
00363 bool block= false;
00364 vector<generic> d;
00365 vector<generic> c;
00366 for (nat i=1; i<N(g); i++) {
00367 if (is_func (g[i], "$lf", 0)) {
00368 if (N(c) == 0) d << generic ("");
00369 else if (N(c) == 1) d << c;
00370 else if (N(c) > 1) d << gen ("$concat", c);
00371 c= vector<generic> ();
00372 }
00373 else if (is_func (g[i], "$cr", 0)) block= true;
00374 else c << replace_lf (g[i]);
00375 }
00376 if (N(c) == 1) d << c;
00377 else if (N(c) != 0) d << gen ("$concat", c);
00378 if (N(d) != 1 || block) return gen ("$document", d);
00379 return d[0];
00380 }
00381 else if (is<compound> (g)) {
00382 vector<generic> v;
00383 for (nat i=1; i<N(g); i++)
00384 v << replace_lf (g[i]);
00385 return gen (g[0], v);
00386 }
00387 else {
00388 mmout << "g= " << g << ": " << type_name (g) << "\n";
00389 ERROR ("TeXmacs document expected");
00390 }
00391 }
00392
00393
00394
00395
00396
00397 generic
00398 texmacs_expand (const generic& g) {
00399 if (is_func (g, "tm$with"))
00400 return texmacs_expand (g[N(g)-1]);
00401 else if (is_func (g, "tm$itemize", 1) || is_func (g, "tm$enumerate", 1))
00402 return gen ("$indent", texmacs_expand (g[1]));
00403 else if (is_func (g, "tm$item", 0))
00404 return generic ("* ");
00405 else if (is_func (g, "tm$folded", 2))
00406 return gen ("$varindent",
00407 gen ("$concat",
00408 generic ("o "), texmacs_expand (g[1])));
00409 else if (is_func (g, "tm$unfolded", 2))
00410 return gen ("$varindent",
00411 gen ("$concat",
00412 generic ("* "), texmacs_expand (g[1]),
00413 generic ("$lf"), texmacs_expand (g[2])));
00414 else if (is_func (g, "tm$folded-explain", 2))
00415 return texmacs_expand (g[1]);
00416 else if (is_func (g, "tm$unfolded-explain", 2))
00417 return gen ("$concat", texmacs_expand (g[1]),
00418 generic ("$lf"), generic ("$lf"), texmacs_expand (g[2]));
00419 else if (is_func (g, "tm$explain", 2))
00420 return gen ("$concat", texmacs_expand (g[1]), generic ("$lf"),
00421 gen ("$indent", texmacs_expand (g[2])));
00422 else if (is_func (g, "tm$explain-synopsis", 1))
00423 return gen ("$concat", generic (" --- "), texmacs_expand (g[1]));
00424 else if (is<compound> (g)) {
00425 vector<generic> v;
00426 for (nat i=1; i<N(g); i++) v << texmacs_expand (g[i]);
00427 if (is<literal> (g[0]) && starts (literal_to_string (g[0]), "tm$")) {
00428 if (N(v) == 1) return v[0];
00429 else return gen ("$concat", v);
00430 }
00431 else return gen (g[0], v);
00432 }
00433 else return g;
00434 }
00435
00436
00437
00438
00439
00440 static void
00441 texmacs_to_scheme (string& s, const generic& g) {
00442
00443 if (is<literal> (g)) s << quote (literal_to_string (g));
00444 else if (is<compound> (g) && is<literal> (g[0]) &&
00445 literal_to_string (g[0]) == " ")
00446 s << "\" \"";
00447 else if (is<compound> (g) && is<literal> (g[0])) {
00448 string op= literal_to_string (g[0]);
00449 if (starts (op, "tm$")) op= op (2, N(op));
00450 if (!starts (op, "$")) {
00451 mmerr << "op = " << op << "\n";
00452 mmerr << "args= " << compound_to_vector (g) << "\n";
00453 }
00454 ASSERT (starts (op, "$"), "invalid TeXmacs markup");
00455 s << "(" << op (1, N(op));
00456 for (nat i=1; i<N(g); i++) {
00457 s << " ";
00458 texmacs_to_scheme (s, g[i]);
00459 }
00460 s << ")";
00461 }
00462 else ERROR ("invalid TeXmacs markup");
00463 }
00464
00465 string
00466 as_texmacs_snippet (const generic& g) {
00467 string r= "";
00468 generic h= print_mmx (g);
00469 generic m= add_modes (h, 0, 1);
00470 generic t= as_texmacs (m);
00471 generic l= replace_lf (t);
00472 texmacs_to_scheme (r, l);
00473 return r;
00474 }
00475
00476 string
00477 as_texmacs_scheme (const generic& g) {
00478 string r= "(document ";
00479 generic h= print_mmx (g);
00480 generic m= add_modes (h, 0, 1);
00481 generic t= as_texmacs (m);
00482 generic l= replace_lf (t);
00483 texmacs_to_scheme (r, l);
00484 r << ")";
00485 return r;
00486 }
00487
00488
00489
00490
00491
00492 static string
00493 spaces (nat indent) {
00494 string s;
00495 for (nat i=0; i<indent; i++)
00496 s << " ";
00497 return s;
00498 }
00499
00500 static void
00501 write (string& r, const string& s) {
00502 nat i, n=N(s);
00503 for (i=0; i<n; i++) {
00504 char c= s[i];
00505 if (c == ' ' && ends (r, " ")) r << "\\ ";
00506 else if (c == '\n') r << "\\n";
00507 else if (c == '\t') r << "\\t";
00508 else if (c == '\0') r << "\\0";
00509 else if (c == '\\') r << "\\\\";
00510 else if (c == '<') r << "\\<";
00511 else if (c == '|') r << "\\|";
00512 else if (c == '>') r << "\\>";
00513 else if (c == '\34') r << c;
00514 else if (((unsigned char) c) < ' ') r << '\\' << (c+'@');
00515 else r << c;
00516 }
00517 }
00518
00519 static void
00520 scheme_to_tm (string& s, const generic& g, int indent) {
00521
00522 if (is<literal> (g))
00523 write (s, unquote (literal_to_string (g)));
00524 else if (is_func (g, "concat")) {
00525 for (nat i=1; i<N(g); i++)
00526 scheme_to_tm (s, g[i], indent);
00527 }
00528 else if (is_func (g, "document")) {
00529 for (nat i=1; i<N(g); i++) {
00530 if (i>1) {
00531 if (ends (s, "\n")) s << "\\;";
00532 s << "\n\n" << spaces (indent);
00533 }
00534 scheme_to_tm (s, g[i], indent);
00535 }
00536 }
00537 else if (is<compound> (g) && N(g) > 0 && is<literal> (g[0])) {
00538 string func= literal_to_string (g[0]);
00539 vector<generic> args= cdr (compound_to_vector (g));
00540 int i, last, n=N(args);
00541 for (i=n-1; i>=0; i--)
00542 if (is_func (args[i], "document"))
00543 break;
00544 last= i;
00545 if (last >= 0) {
00546 for (i=0; i<=n; i++) {
00547 bool flag= (i<n) && is_func (args[i], "document");
00548 if (i==0) s << "<\\" << func;
00549 else if (i==last+1) s << "</" << func;
00550 else if (is_func (args[i-1], "document")) s << "<|" << func;
00551 if (i==n) { s << ">"; break; }
00552
00553 if (flag) {
00554 s << ">";
00555 if (!ends (s, "\n")) s << "\n" << spaces (indent + 2);
00556 scheme_to_tm (s, args[i], indent + 2);
00557 if (!ends (s, "\n")) s << "\n" << spaces (indent);
00558 }
00559 else {
00560 s << "|";
00561 scheme_to_tm (s, args[i], indent);
00562 }
00563 }
00564 }
00565 else {
00566 s << "<" << func;
00567 for (i=0; i<n; i++) {
00568 s << "|";
00569 scheme_to_tm (s, args[i], indent);
00570 }
00571 s << ">";
00572 }
00573 }
00574 else ERROR ("invalid scheme markup");
00575 }
00576
00577 static string
00578 as_snippet (const generic& g) {
00579 string r= "";
00580 generic h= print_mmx (g);
00581 generic m= h;
00582 generic t= as_texmacs (m);
00583 generic l= replace_lf (t);
00584 texmacs_to_scheme (r, l);
00585 return r;
00586 }
00587
00588 string
00589 flatten_as_tm (const generic& x) {
00590 string r;
00591 generic g= as_generic (flatten (x));
00592 g= parse_lisp (as_snippet (g), true);
00593 if (is_func (g, "text", 1)) g= g[1];
00594 scheme_to_tm (r, g, 0);
00595 return r;
00596 }
00597
00598 string
00599 flatten_as_tm (const generic& x, const string& style) {
00600 string r;
00601 generic g= as_generic (flatten (x));
00602 g= parse_lisp (as_snippet (g), true);
00603 if (is_func (g, "text", 1)) g= g[1];
00604 if (!is_func (g, "document")) g= gen ("document", g);
00605 g= gen ("document", gen ("TeXmacs", string ("1.0.7.8")),
00606 gen ("style", style), gen ("body", g));
00607 scheme_to_tm (r, g, 0);
00608 return r;
00609 }
00610
00611 }
