1
2 /******************************************************************************
3 * MODULE : to_scheme.cpp
4 * DESCRIPTION: conversion of scheme expressions to TeXmacs trees
5 * COPYRIGHT : (C) 1999 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 "convert.hpp"
13 #include "analyze.hpp"
14 #include "drd_std.hpp"
15 #include "path.hpp"
16
17 /******************************************************************************
18 * Handling escape characters
19 ******************************************************************************/
20
21 string
unslash(string s)22 unslash (string s) {
23 int i, n= N(s);
24 string r;
25 for (i=0; i<n; i++)
26 if ((s[i]=='\\') && ((i+1)<n))
27 switch (s[++i]) {
28 case '0': r << ((char) 0); break;
29 case 'n': r << '\n'; break;
30 case 't': r << '\t'; break;
31 default: r << s[i];
32 }
33 else r << s[i];
34 return r;
35 }
36
37 /******************************************************************************
38 * Converting strings to scheme trees
39 ******************************************************************************/
40
41 static bool
is_spc(char c)42 is_spc (char c) {
43 return (c==' ') || (c=='\t') || (c=='\n');
44 }
45
46 static scheme_tree
string_to_scheme_tree(string s,int & i)47 string_to_scheme_tree (string s, int& i) {
48 for (; i<N(s); i++)
49 switch (s[i]) {
50
51 case ' ':
52 case '\t':
53 case '\n':
54 break;
55 case '(':
56 {
57 scheme_tree p (TUPLE);
58 i++;
59 while (true) {
60 while ((i<N(s)) && is_spc(s[i])) i++;
61 if ((i==N(s)) || (s[i]==')')) break;
62 p << string_to_scheme_tree (s, i);
63 }
64 if (i<N(s)) i++;
65 return p;
66 }
67
68 case '\'':
69 i++;
70 return scheme_tree (TUPLE, "\'", string_to_scheme_tree (s, i));
71
72 case '\"':
73 { // "
74 int start= i++;
75 while ((i<N(s)) && (s[i]!='\"')) { // "
76 if ((i<N(s)-1) && (s[i]=='\\')) i++;
77 i++;
78 }
79 if (i<N(s)) i++;
80 return scheme_tree (unslash (s (start, i)));
81 }
82
83 case ';':
84 while ((i<N(s)) && (s[i]!='\n')) i++;
85 break;
86
87 default:
88 {
89 int start= i;
90 while ((i<N(s)) && (!is_spc(s[i])) && (s[i]!='(') && (s[i]!=')')) {
91 if ((i<N(s)-1) && (s[i]=='\\')) i++;
92 i++;
93 }
94 return scheme_tree (unslash (s (start, i)));
95 }
96 }
97
98 return "";
99 }
100
101 scheme_tree
string_to_scheme_tree(string s)102 string_to_scheme_tree (string s) {
103 s= replace (s, "\015", "");
104 int i=0;
105 return string_to_scheme_tree (s, i);
106 }
107
108 scheme_tree
block_to_scheme_tree(string s)109 block_to_scheme_tree (string s) {
110 scheme_tree p (TUPLE);
111 int i=0;
112 while ((i<N(s)) && (is_spc (s[i]) || s[i]==')')) i++;
113 while (i<N(s)) {
114 p << string_to_scheme_tree (s, i);
115 while ((i<N(s)) && (is_spc (s[i]) || s[i]==')')) i++;
116 }
117 return p;
118 }
119
120 /******************************************************************************
121 * Converting scheme trees to trees
122 ******************************************************************************/
123
124 tree
scheme_tree_to_tree(scheme_tree t,hashmap<string,int> codes,bool flag)125 scheme_tree_to_tree (scheme_tree t, hashmap<string,int> codes, bool flag) {
126 if (is_atomic (t)) return scm_unquote (t->label);
127 else if ((N(t) == 0) || is_compound (t[0])) {
128 convert_error << "Invalid scheme tree " << t << "\n";
129 return
130 compound ("errput",
131 concat ("The tree was ", as_string (L(t)), ": ", tree (t)));
132 }
133 else {
134 int i, n= N(t);
135 tree_label code= (tree_label) codes [t[0]->label];
136 if (flag) code= make_tree_label (t[0]->label);
137 if (code == UNKNOWN) {
138 tree u (EXPAND, n);
139 u[0]= copy (t[0]);
140 for (i=1; i<n; i++)
141 u[i]= scheme_tree_to_tree (t[i], codes, flag);
142 return u;
143 }
144 else {
145 tree u (code, n-1);
146 for (i=1; i<n; i++)
147 u[i-1]= scheme_tree_to_tree (t[i], codes, flag);
148 return u;
149 }
150 }
151 }
152
153 tree
scheme_tree_to_tree(scheme_tree t,string version)154 scheme_tree_to_tree (scheme_tree t, string version) {
155 version= scm_unquote (version);
156 tree doc, error (ERROR, "bad format or data");
157 if (version_inf (version, "1.0.2.4"))
158 doc= scheme_tree_to_tree (t, get_codes (version), false);
159 else doc= scheme_tree_to_tree (t);
160 if (!is_document (doc)) return error;
161 return upgrade (doc, version);
162 }
163
164 tree
scheme_tree_to_tree(scheme_tree t)165 scheme_tree_to_tree (scheme_tree t) {
166 return scheme_tree_to_tree (t, STD_CODE, true);
167 }
168
169 /******************************************************************************
170 * Converting scheme strings to trees
171 ******************************************************************************/
172
173 tree
scheme_to_tree(string s)174 scheme_to_tree (string s) {
175 return scheme_tree_to_tree (string_to_scheme_tree (s));
176 }
177
178 tree
scheme_document_to_tree(string s)179 scheme_document_to_tree (string s) {
180 tree error (ERROR, "bad format or data");
181 if (starts (s, "(document (apply \"TeXmacs\" ") ||
182 starts (s, "(document (expand \"TeXmacs\" ") ||
183 starts (s, "(document (TeXmacs "))
184 {
185 int i, begin=27;
186 if (starts (s, "(document (expand \"TeXmacs\" ")) begin= 28;
187 if (starts (s, "(document (TeXmacs ")) begin= 19;
188 for (i=begin; i<N(s); i++)
189 if (s[i] == ')') break;
190 string version= s (begin, i);
191 tree t = string_to_scheme_tree (s);
192 return scheme_tree_to_tree (t, version);
193 }
194 return error;
195 }
196