/[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.26 by camm, Thu Oct 6 20:30:08 2005 UTC revision 1.27 by camm, Wed Oct 12 03:12:57 2005 UTC
# Line 60  per_line_prefix(object strm) { Line 60  per_line_prefix(object strm) {
60  #define  WRITEC_NEWLINE(strm) (writec_stream('\n',strm),per_line_prefix(strm))  #define  WRITEC_NEWLINE(strm) (writec_stream('\n',strm),per_line_prefix(strm))
61  #endif  #endif
62    
63  #define to_be_escaped(c) \  #define READ_TABLE_CASE (Vreadtable->s.s_dbind->rt.rt_case)
         (standard_readtable->rt.rt_self[(c)&0377].rte_chattrib \  
          != cat_constituent || \  
          isLower((c)&0377) || (c) == ':')  
   
64    
65  #define mod(x)          ((x)%Q_SIZE)  #define mod(x)          ((x)%Q_SIZE)
66    
# Line 687  object obj,a_list; Line 683  object obj,a_list;
683          @(return `pprint_dispatch(obj,table)`)          @(return `pprint_dispatch(obj,table)`)
684  @)  @)
685    
686    
687    static int
688    constant_case(object x) {
689    
690      fixnum i,j=0,jj;
691      for (i=0;i<x->s.s_fillp;i++,j=jj ? jj : j) {
692        jj=isUpper(x->s.s_self[i]) ? 1 : (isLower(x->s.s_self[i]) ? -1 : 0);
693        if (j*jj==-1)
694          return 0;
695      }
696      return j;
697    
698    }
699        
700    static int
701    needs_escape (object x) {
702    
703      fixnum i;
704    
705      if (x->s.s_fillp && *x->s.s_self==' ')
706        return 1;
707    
708      for (i=0;i<x->s.s_fillp;i++)
709        switch(x->s.s_self[i]) {
710        case '(':
711        case ')':
712        case ':':
713        case '`':
714        case '\'':
715        case '"':
716        case ';':
717        case ',':
718        case '\n':
719          return 1;
720        default:
721          break;
722        }
723    
724      if (!PRINTescape)
725        return 0;
726      if (READ_TABLE_CASE==sKupcase) {
727        for (i=0;i<x->s.s_fillp;i++)
728          if (isLower(x->s.s_self[i]))
729            return 1;
730      } else if (READ_TABLE_CASE==sKdowncase) {
731        for (i=0;i<x->s.s_fillp;i++)
732          if (isUpper(x->s.s_self[i]))
733            return 1;
734      }
735    
736      return !x->s.s_fillp;
737    
738    }
739    
740    static int
741    all_dots(object x) {
742      
743      fixnum i;
744    
745      for (i=0;i<x->s.s_fillp && x->s.s_self[i]=='.';i++);
746      
747      return i==x->s.s_fillp;
748    
749    }
750    
751    #define convertible_upper(c) ((READ_TABLE_CASE==sKupcase||READ_TABLE_CASE==sKinvert)&& isUpper(c))
752    #define convertible_lower(c) ((READ_TABLE_CASE==sKdowncase||READ_TABLE_CASE==sKinvert)&& isLower(c))
753    
754    static void
755    print_symbol_name_body(object x,int pp) {
756    
757      int i,j,fc,tc,lw,k,cc;
758    
759      cc=constant_case(x);
760      k=needs_escape(x);
761      pp=pp && (potential_number_p(x, PRINTbase)||all_dots(x)) ? 0 : 1;
762    
763      if (k)
764        write_ch('|');
765    
766      for (lw=i=0;i<x->s.s_fillp;i++) {
767        j = x->s.s_self[i];
768        if (PRINTescape && (j == '|' || j == '\\'))
769          write_ch('\\');
770        fc=convertible_upper(j) ? 1 :
771            (convertible_lower(j) ? -1 : 0);
772        tc=(READ_TABLE_CASE==sKinvert ? -cc :
773             (PRINTcase == sKupcase ? 1 :
774              (PRINTcase == sKdowncase ? -1 :
775               (PRINTcase == sKcapitalize ? (i==lw ? 1 : -1) : 0))));
776        if (ispunct(j)||isspace(j)) lw=i+1;
777        tc*=pp*fc*fc;
778        fc=tc*tc*(tc-fc)>>1;
779        j+=fc*('A'-'a');
780        write_ch(j);
781        
782      }
783    
784      if (k)
785        write_ch('|');
786    
787    }
788    
789  void  void
790  write_object(x, level)  write_object(x, level)
791  object x;  object x;
792  int level;  int level;
793  {  {
794          object r, y;          object r, y;
795          int i, j, k,lw;          int i, j, k;
796          object *vp;          object *vp;
797          object ppfun;          object ppfun;
798    
# Line 894  int level; Line 993  int level;
993                  break;                  break;
994    
995          case t_symbol:          case t_symbol:
996                  if (!PRINTescape) {            {
                         for (lw = 0,i = 0;  i < x->s.s_fillp;  i++) {  
                                 j = x->s.s_self[i];  
                                 if (isUpper(j)) {  
                                     if (PRINTcase == sKdowncase ||  
                                         (PRINTcase == sKcapitalize && i!=lw))  
                                           j += 'a' - 'A';  
                                  } else if (!isLower(j))  
                                          lw = i + 1;  
                                   write_ch(j);  
997    
998                          }              if (PRINTescape) {
999                          break;                if (x->s.s_hpack == Cnil) {
1000                  }                  if (PRINTcircle) {
1001                  if (x->s.s_hpack == Cnil) {                    for (vp = PRINTvs_top;  vp < PRINTvs_limit;  vp += 2)
1002                      if (PRINTcircle) {                      if (x == *vp) {
1003                          for (vp = PRINTvs_top;  vp < PRINTvs_limit;  vp += 2)                        if (vp[1] != Cnil) {
1004                              if (x == *vp) {                          write_ch('#');
1005                                  if (vp[1] != Cnil) {                          write_decimal((vp-PRINTvs_top)/2+1);
1006                                      write_ch('#');                          write_ch('#');
1007                                      write_decimal((vp-PRINTvs_top)/2+1);                          return;
1008                                      write_ch('#');                        } else {
1009                                      return;                          write_ch('#');
1010                                  } else {                          write_decimal((vp-PRINTvs_top)/2+1);
1011                                      write_ch('#');                          write_ch('=');
1012                                      write_decimal((vp-PRINTvs_top)/2+1);                          vp[1] = Ct;
1013                                      write_ch('=');                        }
                                     vp[1] = Ct;  
                                 }  
                             }  
1014                      }                      }
                     if (PRINTgensym)  
                         write_str("#:");  
                 } else if (x->s.s_hpack == keyword_package)  
                         write_ch(':');  
                 else if (PRINTpackage||find_symbol(x,current_package())!=x  
                          || intern_flag == 0)  
                   {  
                         k = 0;  
                         for (i = 0;  
                              i < x->s.s_hpack->p.p_name->st.st_fillp;  
                              i++) {  
                                 j = x->s.s_hpack->p.p_name  
                                     ->st.st_self[i];  
                                 if (to_be_escaped(j))  
                                         k++;  
                         }  
                         if (k > 0)  
                                 write_ch('|');  
                      for (lw = 0, i = 0;          
                              i < x->s.s_hpack->p.p_name->st.st_fillp;  
                              i++) {  
                                 j = x->s.s_hpack->p.p_name  
                                     ->st.st_self[i];  
                                 if (j == '|' || j == '\\')  
                                         write_ch('\\');  
                                  if (k == 0) {  
                                          if (isUpper(j)) {  
                                                  if (PRINTcase == sKdowncase ||  
                                                      (PRINTcase == sKcapitalize && i!=lw))  
                                                  j += 'a' - 'A';  
                                          } else if (!isLower(j))  
                                                  lw = i + 1;  
                                  }  
                                 write_ch(j);  
                         }  
                         if (k > 0)  
                                 write_ch('|');  
                         if (find_symbol(x, x->s.s_hpack) != x)  
                                 error("can't print symbol");  
                         if (PRINTpackage || intern_flag == INTERNAL)  
                                 write_str("::");  
                         else if (intern_flag == EXTERNAL)  
                                 write_ch(':');  
                         else  
                         FEerror("Pathological symbol --- cannot print.", 0);  
                 }  
                 k = 0;  
                 if (potential_number_p(x, PRINTbase))  
                         k++;  
                 for (i = 0;  i < x->s.s_fillp;  i++) {  
                         j = x->s.s_self[i];  
                         if (to_be_escaped(j))  
                                 k++;  
1015                  }                  }
1016                  for (i = 0;  i < x->s.s_fillp;  i++)                  if (PRINTgensym)
1017                          if (x->s.s_self[i] != '.')                    write_str("#:");
1018                                  goto NOT_DOT;                } else if (x->s.s_hpack == keyword_package) {
1019                  k++;                  write_ch(':');
1020                  } else if (PRINTpackage||find_symbol(x,current_package())!=x || !intern_flag) {
1021          NOT_DOT:                                          
1022                  if (k > 0)                  print_symbol_name_body(x->s.s_hpack->p.p_name,0);
1023                          write_ch('|');                  
1024                   for (lw = 0, i = 0;  i < x->s.s_fillp;  i++) {                  if (find_symbol(x, x->s.s_hpack) != x)
1025                          j = x->s.s_self[i];                    error("can't print symbol");
1026                          if (j == '|' || j == '\\')                  if (PRINTpackage || intern_flag == INTERNAL)
1027                                  write_ch('\\');                    write_str("::");
1028                           if (k == 0) {                  else if (intern_flag == EXTERNAL)
1029                                   if (isUpper(j)) {                    write_ch(':');
1030                                           if (PRINTcase == sKdowncase ||                  else
1031                                               (PRINTcase == sKcapitalize && i != lw))                    FEerror("Pathological symbol --- cannot print.", 0);
1032                                               j += 'a' - 'A';                  
1033                                   } else if (!isLower(j))                }
                                          lw = i + 1;  
                          }  
                         write_ch(j);  
                 }  
                 if (k > 0)  
                         write_ch('|');  
                 break;  
1034    
1035                }
1036                print_symbol_name_body(x,1);
1037                break;
1038              }
1039          case t_array:          case t_array:
1040          {          {
1041                  int subscripts[ARANKLIM];                  int subscripts[ARANKLIM];

Legend:
Removed from v.1.26  
changed lines
  Added in v.1.27

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