/[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.11 by camm, Sat Jul 20 12:41:20 2002 UTC revision 1.12 by camm, Thu Oct 3 05:32:38 2002 UTC
# Line 467  int level; Line 467  int level;
467          object *vt = PRINTvs_top;          object *vt = PRINTvs_top;
468          object *vl = PRINTvs_limit;          object *vl = PRINTvs_limit;
469          bool e = PRINTescape;          bool e = PRINTescape;
470            bool ra = PRINTreadably;
471          bool r = PRINTradix;          bool r = PRINTradix;
472          int b = PRINTbase;          int b = PRINTbase;
473          bool c = PRINTcircle;          bool c = PRINTcircle;
# Line 521  ONCE_MORE: Line 522  ONCE_MORE:
522    
523          old_bds_top = bds_top;          old_bds_top = bds_top;
524          bds_bind(sLAprint_escapeA, PRINTescape?Ct:Cnil);          bds_bind(sLAprint_escapeA, PRINTescape?Ct:Cnil);
525            bds_bind(sLAprint_readablyA, PRINTreadably?Ct:Cnil);
526          bds_bind(sLAprint_radixA, PRINTradix?Ct:Cnil);          bds_bind(sLAprint_radixA, PRINTradix?Ct:Cnil);
527          bds_bind(sLAprint_baseA, make_fixnum(PRINTbase));          bds_bind(sLAprint_baseA, make_fixnum(PRINTbase));
528          bds_bind(sLAprint_circleA, PRINTcircle?Ct:Cnil);          bds_bind(sLAprint_circleA, PRINTcircle?Ct:Cnil);
# Line 571  L: Line 573  L:
573          PRINTbase = b;          PRINTbase = b;
574          PRINTradix = r;          PRINTradix = r;
575          PRINTescape = e;          PRINTescape = e;
576            PRINTreadably = ra;
577          PRINTvs_limit = vl;          PRINTvs_limit = vl;
578          PRINTvs_top = vt;          PRINTvs_top = vt;
579    
# Line 1465  object x; Line 1468  object x;
1468                  FEwrong_type_argument(sLstream, PRINTstream);                  FEwrong_type_argument(sLstream, PRINTstream);
1469          }          }
1470          PRINTescape = symbol_value(sLAprint_escapeA) != Cnil;          PRINTescape = symbol_value(sLAprint_escapeA) != Cnil;
1471            PRINTreadably = symbol_value(sLAprint_readablyA) != Cnil;
1472          PRINTpretty = symbol_value(sLAprint_prettyA) != Cnil;          PRINTpretty = symbol_value(sLAprint_prettyA) != Cnil;
1473          PRINTcircle = symbol_value(sLAprint_circleA) != Cnil;          PRINTcircle = symbol_value(sLAprint_circleA) != Cnil;
1474          y = symbol_value(sLAprint_baseA);          y = symbol_value(sLAprint_baseA);
# Line 1580  int base; Line 1584  int base;
1584   @(defun write (x   @(defun write (x
1585                 &key ((:stream strm) Cnil)                 &key ((:stream strm) Cnil)
1586                      (escape `symbol_value(sLAprint_escapeA)`)                      (escape `symbol_value(sLAprint_escapeA)`)
1587                        (readably `symbol_value(sLAprint_readablyA)`)
1588                      (radix `symbol_value(sLAprint_radixA)`)                      (radix `symbol_value(sLAprint_radixA)`)
1589                      (base `symbol_value(sLAprint_baseA)`)                      (base `symbol_value(sLAprint_baseA)`)
1590                      (circle `symbol_value(sLAprint_circleA)`)                      (circle `symbol_value(sLAprint_circleA)`)
# Line 1602  int base; Line 1607  int base;
1607                  FEerror("~S is not a stream.", 1, strm);                  FEerror("~S is not a stream.", 1, strm);
1608          PRINTvs_top = vs_top;          PRINTvs_top = vs_top;
1609          PRINTstream = strm;          PRINTstream = strm;
1610          PRINTescape = escape != Cnil;          PRINTreadably = readably != Cnil;
1611            PRINTescape = PRINTreadably || escape != Cnil;
1612          PRINTpretty = pretty != Cnil;          PRINTpretty = pretty != Cnil;
1613          PRINTcircle = circle != Cnil;          PRINTcircle = circle != Cnil;
1614          if (type_of(base)!=t_fixnum || fix((base))<2 || fix((base))>36)          if (type_of(base)!=t_fixnum || fix((base))<2 || fix((base))>36)
# Line 1614  int base; Line 1620  int base;
1620          if (PRINTcase != sKupcase && PRINTcase != sKdowncase &&          if (PRINTcase != sKupcase && PRINTcase != sKdowncase &&
1621              PRINTcase != sKcapitalize)              PRINTcase != sKcapitalize)
1622                  FEerror("~S is an illegal PRINT-CASE.", 1, cas);                  FEerror("~S is an illegal PRINT-CASE.", 1, cas);
1623          PRINTgensym = gensym != Cnil;          PRINTgensym = PRINTreadably || gensym != Cnil;
1624          if (level == Cnil)          if (PRINTreadably || level == Cnil)
1625                  PRINTlevel = -1;                  PRINTlevel = -1;
1626          else if (type_of(level) != t_fixnum || fix((level)) < 0)          else if (type_of(level) != t_fixnum || fix((level)) < 0)
1627                  FEerror("~S is an illegal PRINT-LEVEL.", 1, level);                  FEerror("~S is an illegal PRINT-LEVEL.", 1, level);
1628          else          else
1629                  PRINTlevel = fix((level));                  PRINTlevel = fix((level));
1630          if (length == Cnil)          if (PRINTreadably || length == Cnil)
1631                  PRINTlength = -1;                  PRINTlength = -1;
1632          else if (type_of(length) != t_fixnum || fix((length)) < 0)          else if (type_of(length) != t_fixnum || fix((length)) < 0)
1633                  FEerror("~S is an illegal PRINT-LENGTH.", 1, length);                  FEerror("~S is an illegal PRINT-LENGTH.", 1, length);
1634          else          else
1635                  PRINTlength = fix((length));                  PRINTlength = fix((length));
1636          PRINTarray = array != Cnil;          PRINTarray = PRINTreadably || array != Cnil;
1637          if (PRINTcircle) setupPRINTcircle(x,1);          if (PRINTcircle) setupPRINTcircle(x,1);
1638          if (PRINTpretty) {          if (PRINTpretty) {
1639                  qh = qt = qc = 0;                  qh = qt = qc = 0;
# Line 1666  int base; Line 1672  int base;
1672          WRITEC_NEWLINE(strm);          WRITEC_NEWLINE(strm);
1673          {SETUP_PRINT_DEFAULT(obj);          {SETUP_PRINT_DEFAULT(obj);
1674          PRINTstream = strm;          PRINTstream = strm;
1675            PRINTreadably = FALSE;
1676          PRINTescape = TRUE;          PRINTescape = TRUE;
1677          PRINTpretty = TRUE;          PRINTpretty = TRUE;
1678          qh = qt = qc = 0;          qh = qt = qc = 0;
# Line 1803  DEF_ORDINARY("DOWNCASE",sKdowncase,KEYWO Line 1810  DEF_ORDINARY("DOWNCASE",sKdowncase,KEYWO
1810  DEF_ORDINARY("CAPITALIZE",sKcapitalize,KEYWORD,"");  DEF_ORDINARY("CAPITALIZE",sKcapitalize,KEYWORD,"");
1811  DEF_ORDINARY("STREAM",sKstream,KEYWORD,"");  DEF_ORDINARY("STREAM",sKstream,KEYWORD,"");
1812  DEF_ORDINARY("ESCAPE",sKescape,KEYWORD,"");  DEF_ORDINARY("ESCAPE",sKescape,KEYWORD,"");
1813    DEF_ORDINARY("READABLY",sKreadably,KEYWORD,"");
1814  DEF_ORDINARY("PRETTY",sKpretty,KEYWORD,"");  DEF_ORDINARY("PRETTY",sKpretty,KEYWORD,"");
1815  DEF_ORDINARY("CIRCLE",sKcircle,KEYWORD,"");  DEF_ORDINARY("CIRCLE",sKcircle,KEYWORD,"");
1816  DEF_ORDINARY("BASE",sKbase,KEYWORD,"");  DEF_ORDINARY("BASE",sKbase,KEYWORD,"");
# Line 1813  DEF_ORDINARY("LEVEL",sKlevel,KEYWORD,"") Line 1821  DEF_ORDINARY("LEVEL",sKlevel,KEYWORD,"")
1821  DEF_ORDINARY("LENGTH",sKlength,KEYWORD,"");  DEF_ORDINARY("LENGTH",sKlength,KEYWORD,"");
1822  DEF_ORDINARY("ARRAY",sKarray,KEYWORD,"");  DEF_ORDINARY("ARRAY",sKarray,KEYWORD,"");
1823  DEFVAR("*PRINT-ESCAPE*",sLAprint_escapeA,LISP,Ct,"");  DEFVAR("*PRINT-ESCAPE*",sLAprint_escapeA,LISP,Ct,"");
1824    DEFVAR("*PRINT-READABLY*",sLAprint_readablyA,LISP,Ct,"");
1825  DEFVAR("*PRINT-PRETTY*",sLAprint_prettyA,LISP,Ct,"");  DEFVAR("*PRINT-PRETTY*",sLAprint_prettyA,LISP,Ct,"");
1826  DEFVAR("*PRINT-CIRCLE*",sLAprint_circleA,LISP,Cnil,"");  DEFVAR("*PRINT-CIRCLE*",sLAprint_circleA,LISP,Cnil,"");
1827  DEFVAR("*PRINT-BASE*",sLAprint_baseA,LISP,make_fixnum(10),"");  DEFVAR("*PRINT-BASE*",sLAprint_baseA,LISP,make_fixnum(10),"");
# Line 1839  init_print() Line 1848  init_print()
1848    
1849          PRINTstream = Cnil;          PRINTstream = Cnil;
1850          enter_mark_origin(&PRINTstream);          enter_mark_origin(&PRINTstream);
1851            PRINTreadably = FALSE;
1852          PRINTescape = TRUE;          PRINTescape = TRUE;
1853          PRINTpretty = FALSE;          PRINTpretty = FALSE;
1854          PRINTcircle = FALSE;          PRINTcircle = FALSE;
# Line 1875  object obj, strm; Line 1885  object obj, strm;
1885          case t_string:          case t_string:
1886          case t_character:          case t_character:
1887                  PRINTstream = strm;                  PRINTstream = strm;
1888                    PRINTreadably = FALSE;
1889                  PRINTescape = FALSE;                  PRINTescape = FALSE;
1890                  write_ch_fun = writec_PRINTstream;                  write_ch_fun = writec_PRINTstream;
1891                  write_object(obj, 0);                  write_object(obj, 0);
# Line 1883  object obj, strm; Line 1894  object obj, strm;
1894          default:          default:
1895                  {SETUP_PRINT_DEFAULT(obj);                  {SETUP_PRINT_DEFAULT(obj);
1896                  PRINTstream = strm;                  PRINTstream = strm;
1897                    PRINTreadably = FALSE;
1898                  PRINTescape = FALSE;                  PRINTescape = FALSE;
1899                  write_object(obj, 0);                  write_object(obj, 0);
1900                  CLEANUP_PRINT_DEFAULT;}                  CLEANUP_PRINT_DEFAULT;}
# Line 1908  object obj, strm; Line 1920  object obj, strm;
1920          case t_string:          case t_string:
1921          case t_character:          case t_character:
1922                  PRINTstream = strm;                  PRINTstream = strm;
1923                    PRINTreadably = FALSE;
1924                  PRINTescape = TRUE;                  PRINTescape = TRUE;
1925                  write_ch_fun = writec_PRINTstream;                  write_ch_fun = writec_PRINTstream;
1926                  write_object(obj, 0);                  write_object(obj, 0);
# Line 1916  object obj, strm; Line 1929  object obj, strm;
1929          default:          default:
1930                  {SETUP_PRINT_DEFAULT(obj);                  {SETUP_PRINT_DEFAULT(obj);
1931                  PRINTstream = strm;                  PRINTstream = strm;
1932                    PRINTreadably = FALSE;
1933                  PRINTescape = TRUE;                  PRINTescape = TRUE;
1934                  write_object(obj, 0);                  write_object(obj, 0);
1935                  CLEANUP_PRINT_DEFAULT;}                  CLEANUP_PRINT_DEFAULT;}

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

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