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