Line data Source code
1 : % Copyright (C) 2012-2021,2022 John E. Davis
2 : %
3 : % This file is part of the S-Lang Library and may be distributed under the
4 : % terms of the GNU General Public License. See the file COPYING for
5 : % more information.
6 : %---------------------------------------------------------------------------
7 1 : private variable Pager_Rows = NULL;
8 1 : private variable Pager = getenv ("PAGER");
9 1 : if (Pager == NULL)
10 0 : Pager = "more";
11 :
12 : % Print Methods
13 1 : private variable Print_Device_Type = struct
14 : {
15 : fp,
16 : printf,
17 : puts,
18 : close,
19 : clientdata
20 : };
21 :
22 : % Print to file-pointer method
23 : private define fp_puts_method (p, str)
24 : {
25 1765 : variable n = fputs (str, p.fp);
26 1765 : if (n != strbytelen (str))
27 0 : return -1;
28 1765 : return n;
29 : }
30 :
31 : private define fp_printf_method ()
32 : {
33 1698 : variable args = __pop_args (_NARGS-1);
34 1698 : variable p = ();
35 1698 : return fp_puts_method (p, sprintf (__push_args(args)));
36 : }
37 : private define fp_close_method (p)
38 : {
39 7 : return fclose (p.fp);
40 : }
41 : private define new_fp_print (fp)
42 : {
43 27 : variable p = @Print_Device_Type;
44 27 : p.fp = fp;
45 27 : p.puts = &fp_puts_method;
46 27 : p.printf = &fp_printf_method;
47 27 : return p;
48 : }
49 :
50 : % Print to a pager
51 :
52 : #ifexists SIGPIPE
53 : private variable Sigpipe_Handler;
54 : #endif
55 :
56 : private define close_pager (fp)
57 : {
58 13 : if (fp != NULL)
59 13 : () = pclose (fp);
60 : #ifexists SIGPIPE
61 13 : signal (SIGPIPE, Sigpipe_Handler);
62 : #endif
63 : }
64 : private define pager_close_method (p)
65 : {
66 13 : close_pager (p.fp);
67 13 : return 0;
68 : }
69 :
70 : private define new_pager_print (cmd)
71 : {
72 : #ifnexists popen
73 : return NULL;
74 : #else
75 : # ifexists SIGPIPE
76 14 : signal (SIGPIPE, SIG_IGN, &Sigpipe_Handler);
77 : # endif
78 : try
79 : {
80 14 : variable fp = popen (cmd, "w");
81 :
82 13 : if (fp == NULL)
83 0 : throw OpenError, "Unable to open the pager ($cmd)"$;
84 :
85 : # ifexists setvbuf
86 13 : () = setvbuf (fp, _IONBF, 0);
87 : # endif
88 13 : variable p = new_fp_print (fp);
89 13 : p.close = &pager_close_method;
90 13 : return p;
91 : }
92 : catch AnyError:
93 : {
94 1 : close_pager (fp);
95 : throw;
96 : }
97 : #endif
98 : }
99 :
100 : % Print to a filename
101 : private define new_file_print (filename)
102 : {
103 7 : variable fp = fopen (filename, "w");
104 7 : if (fp == NULL)
105 0 : throw OpenError, "Unable to open $filename for writing."$;
106 :
107 7 : variable p = new_fp_print (fp);
108 7 : p.close = &fp_close_method;
109 7 : p.clientdata = filename;
110 7 : return p;
111 : }
112 :
113 : % Print to a reference
114 : private define ref_printf_method ()
115 : {
116 232 : variable args = __pop_args (_NARGS-1);
117 232 : variable p = ();
118 232 : p.fp = strcat (p.fp, sprintf (__push_args(args)));
119 232 : return 1;
120 : }
121 : private define ref_puts_method (p, str)
122 : {
123 20 : p.fp = strcat (p.fp, str);
124 20 : return 1;
125 : }
126 : private define ref_close_method (p)
127 : {
128 7 : @p.clientdata = p.fp;
129 7 : return 0;
130 : }
131 : private define new_ref_print (ref)
132 : {
133 7 : variable p = @Print_Device_Type;
134 7 : p.fp = "";
135 7 : p.printf = &ref_printf_method;
136 7 : p.puts = &ref_puts_method;
137 7 : p.close = &ref_close_method;
138 7 : p.clientdata = ref;
139 7 : return p;
140 : }
141 :
142 : %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
143 :
144 : private define generic_to_string (x)
145 : {
146 1030 : switch (typeof (x))
147 : {
148 1030 : case String_Type:
149 1000 : return make_printable_string (x);
150 : }
151 : {
152 30 : case BString_Type:
153 1 : return sprintf ("\"%S\"", x);
154 : }
155 :
156 29 : return string (x);
157 : }
158 :
159 : private define struct_to_string (s, single_line)
160 : {
161 10 : if (s == NULL)
162 0 : return "NULL";
163 :
164 10 : variable names = get_struct_field_names (s);
165 10 : variable comma = "";
166 10 : variable str = "{";
167 10 : variable comma_str = ", ";
168 10 : if (single_line == 0)
169 5 : comma_str = ",\n ";
170 10 : foreach (names)
171 : {
172 20 : variable name = ();
173 20 : str = strcat (str, comma, name, "=", generic_to_string(get_struct_field (s, name)));
174 20 : comma = comma_str;
175 : }
176 10 : return strcat (str, "}");
177 : }
178 :
179 : private define struct_to_single_line_string (s)
180 : {
181 5 : return struct_to_string (s, 1);
182 : }
183 :
184 : private define print_list (a, device)
185 : {
186 5 : if (-1 != device.puts ("{\n"))
187 : {
188 : variable s;
189 5 : foreach s (a)
190 : {
191 5 : if (-1 == device.printf ("%s\n", generic_to_string (s)))
192 0 : break;
193 : }
194 : then
195 5 : () = device.puts ("}\n");
196 : }
197 : }
198 :
199 : private define write_2d_array (device, a, to_str)
200 : {
201 12 : variable dims = array_shape (a);
202 12 : variable nrows = dims[0];
203 12 : variable ncols = dims[1];
204 :
205 12 : _for (0, nrows-1, 1)
206 : {
207 48 : variable i = ();
208 48 : _for (0, ncols-1, 1)
209 : {
210 160 : variable j = ();
211 160 : if (-1 == device.printf ("%s ", (@to_str)(a[i,j])))
212 0 : return -1;
213 : }
214 48 : if (-1 == device.puts ("\n"))
215 0 : return -1;
216 : }
217 12 : return 0;
218 : }
219 :
220 : private define print_array (a, device)
221 : {
222 : variable dims, ndims;
223 :
224 18 : (dims, ndims, ) = array_info (a);
225 18 : variable nrows = dims[0];
226 :
227 : try
228 : {
229 : variable i, j;
230 : variable to_str;
231 18 : if (_is_struct_type (a))
232 5 : to_str = &struct_to_single_line_string;
233 13 : else if (__is_numeric (a))
234 12 : to_str = &string;
235 : else
236 1 : to_str = &generic_to_string;
237 :
238 18 : if (ndims == 1)
239 : {
240 10 : _for i (0, nrows-1, 1)
241 : {
242 1765 : if (-1 == device.printf ("%s\n", (@to_str)(a[i])))
243 : return;
244 : }
245 : return;
246 : }
247 :
248 8 : if (ndims == 2)
249 : {
250 4 : () = write_2d_array (device, a, to_str);
251 : return;
252 : }
253 :
254 4 : nrows = nint(prod(dims[[0:ndims-3]]));
255 4 : variable new_dims = [nrows, dims[ndims-2], dims[ndims-1]];
256 4 : reshape (a, new_dims);
257 4 : _for i (0, nrows-1, 1)
258 : {
259 8 : if ((-1 == write_2d_array (device, a[i,*,*], to_str))
260 : || (-1 == device.puts ("\n")))
261 : return;
262 : }
263 : }
264 : finally
265 : {
266 18 : reshape (a, dims);
267 : }
268 : }
269 :
270 : private define get_pager_rows ()
271 : {
272 6 : if (Pager_Rows != NULL)
273 5 : return Pager_Rows;
274 :
275 : variable rows;
276 : #ifexists slsh_get_screen_size
277 1 : (rows,) = slsh_get_screen_size ();
278 : #else
279 : rows = 24;
280 : #endif
281 1 : return rows - 2; % leave room for the prompt
282 : }
283 :
284 :
285 : define print ()
286 : {
287 : variable usage_string
288 35 : = ("print (OBJ [,&str|File_Type|Filename]);\n"
289 : + "Qualifiers: pager[=pgm], nopager\n");
290 :
291 35 : if (_NARGS == 0)
292 0 : usage (usage_string);
293 :
294 35 : variable pager_pgm = Pager;
295 35 : variable use_pager = -1; % auto
296 :
297 35 : if (qualifier_exists("nopager"))
298 0 : use_pager = 0;
299 35 : else if (qualifier_exists ("pager"))
300 : {
301 8 : use_pager = 1;
302 8 : pager_pgm = qualifier ("pager");
303 8 : if (pager_pgm == NULL)
304 0 : pager_pgm = Pager;
305 : }
306 35 : variable noescape = qualifier_exists ("noescape");
307 :
308 35 : variable device = NULL;
309 35 : if (_NARGS == 2)
310 : {
311 21 : device = ();
312 21 : switch (typeof (device))
313 : {
314 21 : case File_Type:
315 7 : device = new_fp_print (device);
316 : }
317 : {
318 14 : case String_Type:
319 7 : device = new_file_print (device);
320 : }
321 : {
322 7 : case Ref_Type:
323 7 : device = new_ref_print (device);
324 : }
325 : {
326 0 : usage (usage_string);
327 : }
328 21 : use_pager = 0;
329 : }
330 :
331 35 : variable x = ();
332 35 : variable t = typeof (x);
333 35 : variable str_x = NULL;
334 :
335 35 : if (use_pager == -1)
336 : {
337 6 : variable pager_rows = get_pager_rows ();
338 :
339 6 : switch (t)
340 : {
341 6 : case Array_Type:
342 2 : variable dims = array_shape (x);
343 2 : use_pager = ((dims[0] >= pager_rows)
344 : || (prod(dims) >= 10*pager_rows));
345 : }
346 : {
347 4 : case List_Type:
348 1 : use_pager = length (x) >= pager_rows;
349 : }
350 : {
351 3 : case String_Type:
352 1 : use_pager = count_byte_occurrences (x, '\n') >= pager_rows;
353 1 : if (noescape)
354 0 : str_x = x;
355 : }
356 : {
357 2 : if (is_struct_type (x))
358 1 : str_x = struct_to_string (x, 0);
359 : else
360 1 : str_x = generic_to_string (x);
361 :
362 2 : use_pager = (count_byte_occurrences (str_x, '\n') >= pager_rows);
363 : }
364 : }
365 :
366 35 : if (use_pager)
367 14 : device = new_pager_print (pager_pgm);
368 :
369 34 : if (device == NULL)
370 0 : device = new_fp_print (stdout);
371 :
372 : try
373 : {
374 34 : if (t == Array_Type)
375 18 : return print_array (x, device);
376 :
377 16 : if (t == List_Type)
378 5 : return print_list (x, device);
379 :
380 11 : if ((t == String_Type) && use_pager)
381 : {
382 1 : () = device.puts (x);
383 : return;
384 : }
385 :
386 10 : if (str_x != NULL)
387 2 : x = str_x;
388 8 : else if (is_struct_type (x))
389 4 : x = struct_to_string (x, 0);
390 : else
391 4 : x = generic_to_string (x);
392 :
393 10 : if (-1 != device.puts (x))
394 : {
395 10 : if (x[-1] != '\n')
396 10 : () = device.puts ("\n");
397 : }
398 : }
399 : finally
400 : {
401 34 : if (device.close != NULL)
402 27 : () = device.close ();
403 : }
404 : }
405 :
406 : define print_set_pager (pager)
407 : {
408 1 : Pager = pager;
409 : }
410 :
411 : define print_set_pager_lines (n)
412 : {
413 2 : Pager_Rows = n;
414 : }
415 :
|
