1
2 /******************************************************************************
3 * MODULE : concat_active.cpp
4 * DESCRIPTION: Typeset active markup
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 "concater.hpp"
13 #include "file.hpp"
14 #include "image_files.hpp"
15 #include "sys_utils.hpp"
16 #include "analyze.hpp"
17 #include "scheme.hpp"
18 #include "packrat.hpp"
19 #include "convert.hpp"
20
21 /******************************************************************************
22 * Typesetting executable markup
23 ******************************************************************************/
24
25 void
typeset_if(tree t,path ip)26 concater_rep::typeset_if (tree t, path ip) {
27 // This method must be kept consistent with edit_env_rep::exec(tree)
28 // in ../Env/env_exec.cpp
29 if ((N(t)!=2) && (N(t)!=3)) {
30 typeset_executable (t, ip);
31 return;
32 }
33 tree tt= env->exec (t[0]);
34 if (is_compound (tt) || ! is_bool (tt->label)) {
35 typeset_executable (t, ip);
36 return;
37 }
38 marker (descend (ip, 0));
39 if (as_bool (tt->label)) typeset (t[1], descend (ip, 1));
40 else if (N(t) == 3) typeset (t[2], descend (ip, 2));
41 marker (descend (ip, 1));
42 }
43
44 void
typeset_var_if(tree t,path ip)45 concater_rep::typeset_var_if (tree t, path ip) {
46 if (N(t) != 2) { typeset_error (t, ip); return; }
47 tree flag= env->exec (t[0]);
48 box b = typeset_as_concat (env, attach_right (t[1], ip));
49 marker (descend (ip, 0));
50 if (flag == "true") print (b);
51 else print (empty_box (b->ip, b->x1, b->y1, b->x2, b->y2));
52 marker (descend (ip, 1));
53 }
54
55 void
typeset_case(tree t,path ip)56 concater_rep::typeset_case (tree t, path ip) {
57 // This method must be kept consistent with edit_env_rep::exec(tree)
58 // in ../Env/env_exec.cpp
59 if (N(t)<2) {
60 typeset_executable (t, ip);
61 return;
62 }
63 marker (descend (ip, 0));
64 int i, n= N(t);
65 for (i=0; i<(n-1); i+=2) {
66 tree tt= env->exec (t[i]);
67 if (is_compound (tt) || !is_bool (tt->label)) {
68 typeset_executable (t, ip);
69 i=n;
70 }
71 else if (as_bool (tt->label)) {
72 typeset (t[i+1], descend (ip, i+1));
73 i=n;
74 }
75 }
76 if (i<n) typeset (t[i], descend (ip, i));
77 marker (descend (ip, 1));
78 }
79
80 /******************************************************************************
81 * Typesetting linking primitives
82 ******************************************************************************/
83
84 bool
build_locus(edit_env env,tree t,list<string> & ids,string & col,string & ref,string & anchor)85 build_locus (edit_env env, tree t, list<string>& ids, string& col, string &ref, string &anchor) {
86 //cout << "Typeset " << t << "\n";
87 int last= N(t)-1;
88 tree body= env->expand (t[last], true);
89 //cout << "Typeset " << body << "\n";
90 bool accessible= is_accessible (obtain_ip (body));
91 bool visited= false;
92 ref= "";
93 anchor= "";
94
95 if (!is_nil (env->link_env)) {
96 int i, j;
97 for (i=0; i<last; i++) {
98 tree arg= env->exec (t[i]);
99 if (is_compound (arg, "id", 1)) {
100 string id= as_string (arg[0]);
101 if (accessible) env->link_env->insert_locus (id, body);
102 else if (N (obtain_ip (body)) > 1) {
103 extern tree get_subtree (path p);
104 path p= path_up (reverse (descend_decode (obtain_ip (body), 1)));
105 env->link_env->insert_locus ("&" * id, get_subtree (p));
106 }
107 ids= list<string> (id, ids);
108 visited= visited || has_been_visited ("id:" * id);
109 }
110 else if (is_compound (arg, "link") && N(arg) >= 2) {
111 if (is_func (arg[1], ATTR)) arg= copy (arg);
112 else arg= arg (0, 1) * tree (LINK, tree (ATTR)) * arg (1, N(arg));
113 arg[1] << tree ("secure")
114 << (env->secure? tree ("true"): tree ("false"));
115 env->link_env->insert_link (arg);
116 for (j=2; j<N(arg); j++) {
117 if (is_compound (arg[j], "id", 1) && is_atomic (arg[j][0])) {
118 visited= visited || has_been_visited ("id:" * arg[j][0]->label);
119 anchor = arg[j][0]->label;
120 }
121 if (is_compound (arg[j], "url", 1) && is_atomic (arg[j][0])) {
122 visited= visited || has_been_visited ("url:" * arg[j][0]->label);
123 ref = arg[j][0]->label;
124 }
125 }
126 }
127 else if (is_compound (arg, "observer", 2)) {
128 string id= as_string (arg[0]);
129 string cb= cork_to_utf8 (as_string (arg[1]));
130 if (accessible) {
131 if (env->secure ||
132 as_bool (eval ("(secure? '(" * cb * " #f #f #f))")))
133 env->link_env->insert_locus (id, body, cb);
134 }
135 ids= list<string> (id, ids);
136 visited= visited || has_been_visited ("id:" * id);
137 }
138 }
139 }
140
141 bool on_paper= (env->get_string (PAGE_PRINTED) == "true");
142 bool preserve= (get_locus_rendering ("locus-on-paper") == "preserve");
143 string var= (visited? VISITED_COLOR: LOCUS_COLOR);
144 string current_col= env->get_string (COLOR);
145 string locus_col= env->get_string (var);
146 if (on_paper) visited= false;
147 if (locus_col == "preserve") col= current_col;
148 else if (on_paper && preserve) col= current_col;
149 else if (locus_col == "global") col= get_locus_rendering (var);
150 else col= locus_col;
151
152 return accessible;
153 }
154
155 bool
build_locus(edit_env env,tree t,list<string> & ids,string & col)156 build_locus (edit_env env, tree t, list<string>& ids, string& col) {
157 string ref;
158 string anchor;
159 return build_locus(env, t, ids, col, ref, anchor);
160 }
161
162 void
typeset_locus(tree t,path ip)163 concater_rep::typeset_locus (tree t, path ip) {
164 string ref;
165 string anchor;
166
167 if (N(t) == 0) { typeset_error (t, ip); return; }
168 int last= N(t)-1;
169 list<string> ids;
170 string col;
171 if (build_locus (env, t, ids, col, ref, anchor)) {
172 marker (descend (ip, 0));
173 tree old= env->local_begin (COLOR, col);
174 typeset (t[last], descend (ip, last));
175 env->local_end (COLOR, old);
176 marker (descend (ip, 1));
177 }
178 else {
179 tree old= env->local_begin (COLOR, col);
180 box b= typeset_as_concat (env, t[last], descend (ip, last));
181 env->local_end (COLOR, old);
182 print (locus_box (ip, b, ids, env->pixel, ref, anchor));
183 }
184 }
185
186 void
typeset_set_binding(tree t,path ip)187 concater_rep::typeset_set_binding (tree t, path ip) {
188 tree keys= env->exec (t);
189 if (L(keys) == HIDDEN) {
190 keys= keys[0];
191 flag ("set binding", ip, blue);
192 if (N(keys) > 0) {
193 path sip= ip;
194 if (N(t) >= 3 && (!is_nil (env->macro_src))) {
195 tree body= env->expand (tree (ARG, t[2]), true);
196 sip= obtain_ip (body);
197 }
198 path dip= decorate_middle (sip);
199 box b= tag_box (dip, sip, empty_box (dip, 0, 0, 0, env->fn->yx), keys);
200 a << line_item (CONTROL_ITEM, OP_SKIP, b, HYPH_INVALID, "label");
201 }
202 }
203 else typeset_dynamic (keys, ip);
204 }
205
206 static tree
remove_labels(tree t)207 remove_labels (tree t) {
208 if (is_atomic (t)) return copy (t);
209 else if (is_func (t, LABEL)) return "";
210 else if (is_func (t, CONCAT)) {
211 tree r (CONCAT);
212 for (int i=0; i<N(t); i++)
213 if (!is_func (t, LABEL))
214 r << remove_labels (t[i]);
215 if (N(r) == 0) return "";
216 else if (N(r) == 1) return r[0];
217 else return r;
218 }
219 else {
220 tree r (t, N(t));
221 for (int i=0; i<N(t); i++)
222 r[i]= remove_labels (t[i]);
223 return r;
224 }
225 }
226
227 void
typeset_write(tree t,path ip)228 concater_rep::typeset_write (tree t, path ip) {
229 if (N(t) != 2) { typeset_error (t, ip); return; }
230 string s= env->exec_string (t[0]);
231 tree r= remove_labels (env->exec (t[1]));
232 if (env->complete) {
233 if (!env->local_aux->contains (s))
234 env->local_aux (s)= tree (DOCUMENT);
235 env->local_aux (s) << r;
236 }
237 control ("write", ip);
238 }
239
240 void
typeset_toc_notify(tree t,path ip)241 concater_rep::typeset_toc_notify (tree t, path ip) {
242 if (N(t) != 2) { typeset_error (t, ip); return; }
243 string kind = tree_to_verbatim (env->exec (t[0]), false, "cork");
244 string title= tree_to_verbatim (env->exec (t[1]), false, "cork");
245 title= replace (title, "T_EX_MACS", "TeXmacs");
246 title= replace (title, "L^AT_EX", "LaTeX");
247 title= replace (title, "T_EX", "TeX");
248 box b = toc_box (decorate_middle (ip), kind, title, env->fn);
249 marker (descend (ip, 0));
250 print (b);
251 marker (descend (ip, 1));
252 }
253
254 /******************************************************************************
255 * Typesetting other dynamic markup
256 ******************************************************************************/
257
258 void
typeset_specific(tree t,path ip)259 concater_rep::typeset_specific (tree t, path ip) {
260 if (N(t) != 2) { typeset_error (t, ip); return; }
261 string which= env->exec_string (t[0]);
262 if (which == "texmacs" || which == "image") {
263 marker (descend (ip, 0));
264 typeset (t[1], descend (ip, 1));
265 marker (descend (ip, 1));
266 //typeset_dynamic (t[1], descend (ip, 1));
267 }
268 else if (which == "screen" || which == "printer" ||
269 which == "even" || which == "odd") {
270 box sb= typeset_as_concat (env, attach_middle (t[1], ip));
271 box b = specific_box (decorate_middle (ip), sb, which, env->fn);
272 marker (descend (ip, 0));
273 print (b);
274 marker (descend (ip, 1));
275 }
276 else control ("specific", ip);
277 }
278
279 void
typeset_flag(tree t,path ip)280 concater_rep::typeset_flag (tree t, path ip) {
281 if (N(t) != 2 && N(t) != 3) { typeset_error (t, ip); return; }
282 string name= env->exec_string (t[0]);
283 string col = env->exec_string (t[1]);
284 path sip= ip;
285 if ((N(t) >= 3) && (!is_nil (env->macro_src))) {
286 string var= env->exec_string (t[2]);
287 sip= env->macro_src->item [var];
288 }
289 if (((N(t) == 2) || is_accessible (sip)) && (!env->read_only)) {
290 marker (descend (ip, 0));
291 flag_ok (name, ip, named_color (col));
292 marker (descend (ip, 1));
293 }
294 }
295
296 /******************************************************************************
297 * Typesetting images
298 ******************************************************************************/
299
300 #define error_image(t) { \
301 typeset_dynamic (tree (ERROR, "bad image", t), ip); \
302 return; \
303 }
304
305 void
typeset_image(tree t,path ip)306 concater_rep::typeset_image (tree t, path ip) {
307 // determine the image url
308 if (N(t) != 5) error_image ("parameters");
309 tree image_tree= env->exec (t[0]);
310 url image= url_none ();
311 if (is_atomic (image_tree)) {
312 if (N (image_tree->label) == 0)
313 error_image (tree (WITH, "color", "red", "no image"));
314 url im= image_tree->label;
315 image= resolve (relative (env->base_file_name, im));
316 if (is_none (image)) image= "$TEXMACS_PATH/misc/pixmaps/unknown.ps";
317 }
318 else if (is_func (image_tree, TUPLE, 2) &&
319 is_func (image_tree[0], RAW_DATA, 1) &&
320 is_atomic (image_tree[0][0]) && is_atomic (image_tree[1])) {
321 image= url_ramdisc (image_tree[0][0]->label) *
322 url ("image." * image_tree[1]->label);
323 }
324 else error_image (image_tree);
325
326 // determine the original size of the image
327 int iw, ih;
328 image_size (image, iw, ih);
329 double pt= ((double) env->dpi*PIXEL) / 72.0;
330 SI w= (SI) (((double) iw) * pt);
331 SI h= (SI) (((double) ih) * pt);
332
333 // determine the width and the height
334 tree old_w= env->local_begin ("w-length", as_string (w) * "tmpt");
335 tree old_h= env->local_begin ("h-length", as_string (h) * "tmpt");
336 SI imw= (t[1] == ""? w: env->as_length (env->exec (t[1]), "w"));
337 SI imh= (t[2] == ""? h: env->as_length (env->exec (t[2]), "h"));
338 if (t[1] == "" && t[2] != "" && ih != 0)
339 imw= (SI) ((iw * ((double) imh)) / ih);
340 if (t[1] != "" && t[2] == "" && iw != 0)
341 imh= (SI) ((ih * ((double) imw)) / iw);
342 if (imw <= 0 || imh <= 0)
343 error_image (tree (WITH, "color", "red", "null box"));
344 env->local_end ("w-length", old_w);
345 env->local_end ("h-length", old_h);
346
347 // determine the offset
348 old_w= env->local_begin ("w-length", as_string (imw) * "tmpt");
349 old_h= env->local_begin ("h-length", as_string (imh) * "tmpt");
350 SI imx= (t[3] == ""? 0: env->as_length (env->exec (t[3]), "w"));
351 SI imy= (t[4] == ""? 0: env->as_length (env->exec (t[4]), "h"));
352 env->local_end ("w-length", old_w);
353 env->local_end ("h-length", old_h);
354
355 // print the box
356 box imb= image_box (ip, image, imw, imh, env->alpha, env->pixel);
357 print (move_box (ip, imb, imx, imy, true));
358 }
359
360 #undef error_image
361