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