/[gcl]/gcl/o/print.d
ViewVC logotype

Diff of /gcl/o/print.d

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by camm, Fri Jul 12 22:00:49 2002 UTC revision 1.10 by camm, Sat Jul 20 07:10:56 2002 UTC
# Line 70  object sSAprint_structureA; Line 70  object sSAprint_structureA;
70    
71  extern object coerce_stream(object,int);  extern object coerce_stream(object,int);
72    
73    void
74    flush_queue(int);
75    
76    void
77  writec_queue(c)  writec_queue(c)
78  int c;  int c;
79  {  {
# Line 82  int c; Line 86  int c;
86          qc++;          qc++;
87  }  }
88    
89  flush_queue(force)  void
90    flush_queue(int force)
91  {  {
92          int c, i, j, k, l, i0;          int c, i, j, k, l, i0;
93    
# Line 90  BEGIN: Line 95  BEGIN:
95          while (qc > 0) {          while (qc > 0) {
96                  c = queue[qh];                  c = queue[qh];
97                  if (c == MARK)                  if (c == MARK)
98                          goto DO_MARK;                          goto MDO_MARK;
99                  else if (c == UNMARK)                  else if (c == UNMARK)
100                          isp -= 2;                          isp -= 2;
101                  else if (c == SET_INDENT)                  else if (c == SET_INDENT)
102                          indent_stack[isp] = file_column(PRINTstream);                          indent_stack[isp] = file_column(PRINTstream);
103                  else if (c == INDENT) {                  else if (c == INDENT) {
104                          goto DO_INDENT;                          goto MDO_INDENT;
105                  } else if (c == INDENT1) {                  } else if (c == INDENT1) {
106                          i = file_column(PRINTstream)-indent_stack[isp];                          i = file_column(PRINTstream)-indent_stack[isp];
107                          if (i < 8 && indent_stack[isp] < LINE_LENGTH/2) {                          if (i < 8 && indent_stack[isp] < LINE_LENGTH/2) {
# Line 108  BEGIN: Line 113  BEGIN:
113                                          indent_stack[isp]                                          indent_stack[isp]
114                                          = indent_stack[isp-1] + 4;                                          = indent_stack[isp-1] + 4;
115                                  }                                  }
116                                  goto DO_INDENT;                                  goto MDO_INDENT;
117                          }                          }
118                  } else if (c == INDENT2) {                  } else if (c == INDENT2) {
119                          indent_stack[isp] = indent_stack[isp-1] + 2;                          indent_stack[isp] = indent_stack[isp-1] + 2;
# Line 120  BEGIN: Line 125  BEGIN:
125          }          }
126          return;          return;
127    
128  DO_MARK:  MDO_MARK:
129          k = LINE_LENGTH - 1 - file_column(PRINTstream);          k = LINE_LENGTH - 1 - file_column(PRINTstream);
130          for (i = 1, j = 0, l = 1;  l > 0 && i < qc && j < k;  i++) {          for (i = 1, j = 0, l = 1;  l > 0 && i < qc && j < k;  i++) {
131                  c = queue[mod(qh + i)];                  c = queue[mod(qh + i)];
# Line 145  DO_MARK: Line 150  DO_MARK:
150          indent_stack[isp] = indent_stack[isp-1];          indent_stack[isp] = indent_stack[isp-1];
151          goto BEGIN;          goto BEGIN;
152    
153  DO_INDENT:  MDO_INDENT:
154          if (iisp > isp)          if (iisp > isp)
155                  goto PUT_INDENT;                  goto PUT_INDENT;
156          k = LINE_LENGTH - 1 - file_column(PRINTstream);          k = LINE_LENGTH - 1 - file_column(PRINTstream);
# Line 206  FLUSH: Line 211  FLUSH:
211          goto BEGIN;          goto BEGIN;
212  }  }
213    
214    void
215  writec_PRINTstream(c)  writec_PRINTstream(c)
216  int c;  int c;
217  {  {
# Line 215  int c; Line 221  int c;
221                  writec_stream(c, PRINTstream);                  writec_stream(c, PRINTstream);
222  }  }
223    
224    void
225  write_str(s)  write_str(s)
226  char *s;  char *s;
227  {  {
# Line 222  char *s; Line 229  char *s;
229                  write_ch(*s++);                  write_ch(*s++);
230  }  }
231    
232    void
233    write_decimal1(int);
234    
235    void
236  write_decimal(i)  write_decimal(i)
237  int i;  int i;
238  {  {
# Line 232  int i; Line 243  int i;
243          write_decimal1(i);          write_decimal1(i);
244  }  }
245    
246    void
247  write_decimal1(i)  write_decimal1(i)
248  int i;  int i;
249  {  {
# Line 241  int i; Line 253  int i;
253          write_ch(i%10 + '0');          write_ch(i%10 + '0');
254  }  }
255    
256    void
257  write_addr(x)  write_addr(x)
258  object x;  object x;
259  {  {
# Line 257  object x; Line 270  object x;
270          }          }
271  }  }
272    
273  write_base()  void
274    write_base(void)
275  {  {
276          if (PRINTbase == 2)          if (PRINTbase == 2)
277                  write_str("#b");                  write_str("#b");
# Line 287  write_base() Line 301  write_base()
301    
302  object sSAprint_nansA;  object sSAprint_nansA;
303    
304    void
305  edit_double(n, d, sp, s, ep)  edit_double(n, d, sp, s, ep)
306  int n;  int n;
307  double d;  double d;
# Line 358  int *ep; Line 373  int *ep;
373          s[n] = '\0';          s[n] = '\0';
374  }  }
375    
376    void
377  write_double(d, e, shortp)  write_double(d, e, shortp)
378  double d;  double d;
379  int e;  int e;
# Line 435  bool shortp; Line 451  bool shortp;
451          write_decimal(exp);          write_decimal(exp);
452  }  }
453    
454    void
455  call_structure_print_function(x, level)  call_structure_print_function(x, level)
456  object x;  object x;
457  int level;  int level;
# Line 443  int level; Line 460  int level;
460          bool eflag;          bool eflag;
461          bds_ptr old_bds_top;          bds_ptr old_bds_top;
462    
463          int (*wf)() = write_ch_fun;          void (*wf)(int) = write_ch_fun;
464    
465          object *vt = PRINTvs_top;          object *vt = PRINTvs_top;
466          object *vl = PRINTvs_limit;          object *vl = PRINTvs_limit;
# Line 520  ONCE_MORE: Line 537  ONCE_MORE:
537    
538          ifuncall3(S_DATA(x->str.str_def)->print_function,          ifuncall3(S_DATA(x->str.str_def)->print_function,
539                    x, PRINTstream, vs_head);                    x, PRINTstream, vs_head);
540          vs_pop;          vs_popp;
541          eflag = FALSE;          eflag = FALSE;
542    
543  L:  L:
# Line 565  L: Line 582  L:
582  object copy_big();  object copy_big();
583  object coerce_big_to_string(object,int);  object coerce_big_to_string(object,int);
584    
585    bool
586    potential_number_p(object,int);
587    
588    void
589  write_object(x, level)  write_object(x, level)
590  object x;  object x;
591  int level;  int level;
# Line 610  int level; Line 631  int level;
631                                  PRINTradix = FALSE;                                  PRINTradix = FALSE;
632                                  write_object(x, level);                                  write_object(x, level);
633                                  PRINTradix = i;                                  PRINTradix = i;
634                                  vs_pop;                                  vs_popp;
635                                  if (PRINTradix && PRINTbase == 10)                                  if (PRINTradix && PRINTbase == 10)
636                                          write_ch('.');                                          write_ch('.');
637                                  break;                                  break;
# Line 745  int level; Line 766  int level;
766                                  j = x->s.s_self[i];                                  j = x->s.s_self[i];
767                                  if (isUpper(j)) {                                  if (isUpper(j)) {
768                                      if (PRINTcase == sKdowncase ||                                      if (PRINTcase == sKdowncase ||
769                                          PRINTcase == sKcapitalize && i!=lw)                                          (PRINTcase == sKcapitalize && i!=lw))
770                                            j += 'a' - 'A';                                            j += 'a' - 'A';
771                                   } else if (!isLower(j))                                   } else if (!isLower(j))
772                                           lw = i + 1;                                           lw = i + 1;
# Line 799  int level; Line 820  int level;
820                                   if (k == 0) {                                   if (k == 0) {
821                                           if (isUpper(j)) {                                           if (isUpper(j)) {
822                                                   if (PRINTcase == sKdowncase ||                                                   if (PRINTcase == sKdowncase ||
823                                                       PRINTcase == sKcapitalize && i!=lw)                                                       (PRINTcase == sKcapitalize && i!=lw))
824                                                   j += 'a' - 'A';                                                   j += 'a' - 'A';
825                                           } else if (!isLower(j))                                           } else if (!isLower(j))
826                                                   lw = i + 1;                                                   lw = i + 1;
# Line 840  int level; Line 861  int level;
861                           if (k == 0) {                           if (k == 0) {
862                                   if (isUpper(j)) {                                   if (isUpper(j)) {
863                                           if (PRINTcase == sKdowncase ||                                           if (PRINTcase == sKdowncase ||
864                                               PRINTcase == sKcapitalize && i != lw)                                               (PRINTcase == sKcapitalize && i != lw))
865                                               j += 'a' - 'A';                                               j += 'a' - 'A';
866                                   } else if (!isLower(j))                                   } else if (!isLower(j))
867                                           lw = i + 1;                                           lw = i + 1;
# Line 924  int level; Line 945  int level;
945                          if (n == x->a.a_rank) {                          if (n == x->a.a_rank) {
946                                  vs_push(aref(x, m));                                  vs_push(aref(x, m));
947                                  write_object(vs_head, level+n);                                  write_object(vs_head, level+n);
948                                  vs_pop;                                  vs_popp;
949                          } else                          } else
950                                  write_ch('#');                                  write_ch('#');
951                          j = n-1;                          j = n-1;
# Line 986  int level; Line 1007  int level;
1007                          }                          }
1008                          vs_push(aref(x, 0));                          vs_push(aref(x, 0));
1009                          write_object(vs_head, level+1);                          write_object(vs_head, level+1);
1010                          vs_pop;                          vs_popp;
1011                          for (i = 1;  i < x->v.v_fillp;  i++) {                          for (i = 1;  i < x->v.v_fillp;  i++) {
1012                                  write_ch(INDENT);                                  write_ch(INDENT);
1013                                  if (PRINTlength>=0 && i>=PRINTlength){                                  if (PRINTlength>=0 && i>=PRINTlength){
# Line 995  int level; Line 1016  int level;
1016                                  }                                  }
1017                                  vs_push(aref(x, i));                                  vs_push(aref(x, i));
1018                                  write_object(vs_head, level+1);                                  write_object(vs_head, level+1);
1019                                  vs_pop;                                  vs_popp;
1020                          }                          }
1021                  }                  }
1022                  write_ch(')');                  write_ch(')');
# Line 1268  int level; Line 1289  int level;
1289                  fix(y) = x->rnd.rnd_value;                  fix(y) = x->rnd.rnd_value;
1290                  vs_push(y);                  vs_push(y);
1291                  write_object(y, level);                  write_object(y, level);
1292                  vs_pop;                  vs_popp;
1293                  break;                  break;
1294    
1295          case t_structure:          case t_structure:
# Line 1302  int level; Line 1323  int level;
1323                          x = structure_to_list(x);                          x = structure_to_list(x);
1324                          vs_push(x);                          vs_push(x);
1325                          write_object(x, level);                          write_object(x, level);
1326                          vs_pop;                          vs_popp;
1327                          break;                          break;
1328                  }                  }
1329                  call_structure_print_function(x, level);                  call_structure_print_function(x, level);
# Line 1320  int level; Line 1341  int level;
1341                          write_ch('p');                          write_ch('p');
1342                          vs_push(namestring(x));                          vs_push(namestring(x));
1343                          write_object(vs_head, level);                          write_object(vs_head, level);
1344                          vs_pop;                          vs_popp;
1345                  } else {                  } else {
1346                          write_str("#<pathname ");                          write_str("#<pathname ");
1347                          write_addr(x);                          write_addr(x);
# Line 1369  int level; Line 1390  int level;
1390    
1391  char travel_push_type[32];  char travel_push_type[32];
1392    
1393    void
1394  travel_push_object(x)  travel_push_object(x)
1395  object x;  object x;
1396  {  {
# Line 1408  BEGIN: Line 1430  BEGIN:
1430          }          }
1431  }  }
1432    
1433    void
   
1434  setupPRINTcircle(x,dogensyms)  setupPRINTcircle(x,dogensyms)
1435       object x;       object x;
1436       int dogensyms;       int dogensyms;
# Line 1427  setupPRINTcircle(x,dogensyms) Line 1448  setupPRINTcircle(x,dogensyms)
1448     PRINTvs_limit = vs_top = vq;     PRINTvs_limit = vs_top = vq;
1449   }   }
1450    
1451    void
1452  setupPRINTdefault(x)  setupPRINTdefault(x)
1453  object x;  object x;
1454  {  {
1455          object y;          object y;
         object *vp, *vq;  
1456    
1457          PRINTvs_top = vs_top;          PRINTvs_top = vs_top;
1458          PRINTstream = symbol_value(sLAstandard_outputA);          PRINTstream = symbol_value(sLAstandard_outputA);
# Line 1491  object x; Line 1512  object x;
1512          PRINTstructure = symbol_value(sSAprint_structureA) != Cnil;          PRINTstructure = symbol_value(sSAprint_structureA) != Cnil;
1513  }  }
1514    
1515  cleanupPRINT()  void
1516    cleanupPRINT(void)
1517  {  {
1518          vs_top = PRINTvs_top;          vs_top = PRINTvs_top;
1519          if (PRINTpretty)          if (PRINTpretty)
1520                  flush_queue(TRUE);                  flush_queue(TRUE);
1521  }  }
1522    
1523    void
1524  write_object_by_default(x)  write_object_by_default(x)
1525  object x;  object x;
1526  {  {
# Line 1507  object x; Line 1530  object x;
1530          CLEANUP_PRINT_DEFAULT;          CLEANUP_PRINT_DEFAULT;
1531  }  }
1532    
1533    void
1534  terpri_by_default()  terpri_by_default()
1535  {  {
1536          PRINTstream = symbol_value(sLAstandard_outputA);          PRINTstream = symbol_value(sLAstandard_outputA);
# Line 1563  int base; Line 1587  int base;
1587                      ((:case cas) `symbol_value(sLAprint_caseA)`)                      ((:case cas) `symbol_value(sLAprint_caseA)`)
1588                      (gensym `symbol_value(sLAprint_gensymA)`)                      (gensym `symbol_value(sLAprint_gensymA)`)
1589                      (array `symbol_value(sLAprint_arrayA)`))                      (array `symbol_value(sLAprint_arrayA)`))
         object *vp, *vq;  
1590          struct printStruct printStructBuf;          struct printStruct printStructBuf;
1591          struct printStruct *old_printStructBufp = printStructBufp;            struct printStruct *old_printStructBufp = printStructBufp;  
1592  @  @
# Line 1801  DEFVAR("*PRINT-PACKAGE*",sSAprint_packag Line 1824  DEFVAR("*PRINT-PACKAGE*",sSAprint_packag
1824  DEFVAR("*PRINT-STRUCTURE*",sSAprint_structureA,SI,Cnil,"");  DEFVAR("*PRINT-STRUCTURE*",sSAprint_structureA,SI,Cnil,"");
1825  DEF_ORDINARY("PRETTY-PRINT-FORMAT",sSpretty_print_format,SI,"");  DEF_ORDINARY("PRETTY-PRINT-FORMAT",sSpretty_print_format,SI,"");
1826    
1827    void
1828  init_print()  init_print()
1829  {  {
1830    
# Line 1924  object strm; Line 1948  object strm;
1948          return(Cnil);          return(Cnil);
1949  }  }
1950    
1951    void
1952  write_string(strng, strm)  write_string(strng, strm)
1953  object strng, strm;  object strng, strm;
1954  {  {
# Line 1943  object strng, strm; Line 1968  object strng, strm;
1968  /*  /*
1969          THE ULTRA-SPECIAL-DINNER-SERVICE OPTIMIZATION          THE ULTRA-SPECIAL-DINNER-SERVICE OPTIMIZATION
1970  */  */
1971    void
1972  princ_str(s, sym)  princ_str(s, sym)
1973  char *s;  char *s;
1974  object sym;  object sym;
# Line 1956  object sym; Line 1982  object sym;
1982          writestr_stream(s, sym);          writestr_stream(s, sym);
1983  }  }
1984    
1985    void
1986  princ_char(c, sym)  princ_char(c, sym)
1987  int c;  int c;
1988  object sym;  object sym;
# Line 1975  object sym; Line 2002  object sym;
2002  }  }
2003    
2004    
2005    void
2006  pp(x)  pp(x)
2007  object x;  object x;
2008  {  {
# Line 1982  princ(x,Cnil); Line 2010  princ(x,Cnil);
2010  flush_stream(symbol_value(sLAstandard_outputA));  flush_stream(symbol_value(sLAstandard_outputA));
2011  }  }
2012    
2013    object
2014  set_line_length(n)  set_line_length(n)
2015  int n;  int n;
2016  {  {
2017    return line_length = n;    return make_fixnum(line_length = n);
2018  }  }
2019    
2020  DEFVAR("*PRINT-NANS*",sSAprint_nansA,SI,Cnil,"");  DEFVAR("*PRINT-NANS*",sSAprint_nansA,SI,Cnil,"");
2021    
2022    void
2023  init_print_function()  init_print_function()
2024  {  {
2025          make_function("WRITE", Lwrite);          make_function("WRITE", Lwrite);

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26