home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / bytecomp / print.c.patch < prev    next >
Encoding:
Text File  |  1991-10-29  |  6.7 KB  |  234 lines
  1. *** old-print.c    Sun Jul 28 14:57:00 1991
  2. --- print.c    Mon Oct 28 23:46:18 1991
  3. ***************
  4. *** 52,59 ****
  5. --- 52,61 ----
  6.   /* Nonzero means print newlines in strings as \n.  */
  7.   
  8.   int print_escape_newlines;
  9. + int print_readably;
  10.   
  11.   Lisp_Object Qprint_escape_newlines;
  12. + Lisp_Object Qprint_readably;
  13.   
  14.   /* Nonzero means print newline before next minibuffer message.
  15.      Defined in xdisp.c */
  16. ***************
  17. *** 608,613 ****
  18. --- 610,617 ----
  19.   #endif
  20.       {
  21.       default:
  22. +       if (print_readably)
  23. +     error ("printing illegal data type #o%3o", (int) XTYPE (obj));
  24.         /* We're in trouble if this happens!
  25.        Probably should just abort () */
  26.         strout ("#<EMACS BUG: ILLEGAL DATATYPE ", -1, printcharfun);
  27. ***************
  28. *** 670,675 ****
  29. --- 674,693 ----
  30.       register unsigned char *end = p + XSYMBOL (obj)->name->size;
  31.       register unsigned char c;
  32.   
  33. + #if 0
  34. +     /* This is a dangerous and certainly-doesn't-do-what-you-meant kind of
  35. +        thing to do, but there's quite a lot of code out there that does this,
  36. +        so let it slide for now...
  37. +      */
  38. + 
  39. +     if (print_readably) {
  40. +       Lisp_Object tem = oblookup (Vobarray, p, end-p);
  41. +       if (!EQ (tem, obj))
  42. +         /* (read) would return a new symbol with the same name. */
  43. +         error ("printing an uninterned symbol named \"%s\"", p);
  44. +     }
  45. + #endif
  46. + 
  47.       if (p != end && (*p == '-' || *p == '+')) p++;
  48.           if (p == end)
  49.         confusing = 0;
  50. ***************
  51. *** 706,711 ****
  52. --- 724,739 ----
  53.         break;
  54.       }
  55.   
  56. +       /* If Vprint_readably is on, print (quote -foo-) as '-foo- */
  57. +       if (print_readably &&
  58. +       EQ (XCONS (obj)->car, Qquote) &&
  59. +       XTYPE (XCONS (obj)->cdr) == Lisp_Cons &&
  60. +       NULL (XCONS (XCONS (obj)->cdr)->cdr)) {
  61. +     PRINTCHAR ('\'');
  62. +     print (XCONS (XCONS (obj)->cdr)->car, printcharfun, escapeflag);
  63. +     break;
  64. +       }
  65. + 
  66.         PRINTCHAR ('(');
  67.         {
  68.       register int i = 0;
  69. ***************
  70. *** 735,741 ****
  71.         break;
  72.   
  73.       case Lisp_Compiled:
  74. !       strout ("#<byte-code ", -1, printcharfun);
  75.       case Lisp_Vector:
  76.         PRINTCHAR ('[');
  77.         {
  78. --- 763,769 ----
  79.         break;
  80.   
  81.       case Lisp_Compiled:
  82. !       strout ((print_readably ? "#" : "#<byte-code "), -1, printcharfun);
  83.       case Lisp_Vector:
  84.         PRINTCHAR ('[');
  85.         {
  86. ***************
  87. *** 749,755 ****
  88.         }
  89.         }
  90.         PRINTCHAR (']');
  91. !       if (XTYPE (obj) == Lisp_Compiled)
  92.       PRINTCHAR ('>');
  93.         break;
  94.   
  95. --- 777,783 ----
  96.         }
  97.         }
  98.         PRINTCHAR (']');
  99. !       if (!print_readably && XTYPE (obj) == Lisp_Compiled)
  100.       PRINTCHAR ('>');
  101.         break;
  102.   
  103. ***************
  104. *** 757,762 ****
  105. --- 785,794 ----
  106.       case Lisp_Interval:
  107.         if (escapeflag)
  108.       {
  109. +       if (print_readably)
  110. +         error ("printing unreadable object #<interval [%d %d]>",
  111. +            XINTERVAL (obj)->position, XINTERVAL (obj)->my_length);
  112. +       
  113.         strout ("#<interval ", -1, printcharfun);
  114.         sprintf (buf, "[%d, %d]", XINTERVAL (obj)->position,
  115.              XINTERVAL (obj)->my_length);
  116. ***************
  117. *** 779,784 ****
  118. --- 811,823 ----
  119.         break;
  120.   
  121.       case Lisp_Buffer:
  122. +       if (print_readably) {
  123. +     if (NULL (XBUFFER (obj)->name))
  124. +       error ("printing unreadable object #<killed buffer>");
  125. +     else
  126. +       error ("printing unreadable object #<buffer %s>",
  127. +          XSTRING (XBUFFER (obj)->name)->data);
  128. +       }
  129.         if (NULL (XBUFFER (obj)->name))
  130.       strout ("#<killed buffer>", -1, printcharfun);
  131.         else if (escapeflag)
  132. ***************
  133. *** 794,799 ****
  134. --- 833,842 ----
  135.       case Lisp_Process:
  136.         if (escapeflag)
  137.       {
  138. +       if (print_readably)
  139. +         error ("printing unreadable object #<process %s>",
  140. +            XSTRING (XPROCESS (obj)->name)->data);
  141. +       
  142.         strout ("#<process ", -1, printcharfun);
  143.         strout (XSTRING (XPROCESS (obj)->name)->data, -1, printcharfun);
  144.         PRINTCHAR ('>');
  145. ***************
  146. *** 803,808 ****
  147. --- 846,855 ----
  148.         break;
  149.   
  150.       case Lisp_Window:
  151. +       if (print_readably)
  152. +     error ("printing unreadable object #<window %d>",
  153. +            XFASTINT (XWINDOW (obj)->sequence_number));
  154. + 
  155.         strout ("#<window ", -1, printcharfun);
  156.         sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number));
  157.         strout (buf, -1, printcharfun);
  158. ***************
  159. *** 816,826 ****
  160. --- 863,880 ----
  161.         break;
  162.   
  163.       case Lisp_Window_Configuration:
  164. +       if (print_readably)
  165. +     error ("printing unreadable object #<window-configuration>");
  166.         strout ("#<window-configuration>", -1, printcharfun);
  167.         break;
  168.   
  169.   #ifdef MULTI_SCREEN
  170.       case Lisp_Screen:
  171. +       if (print_readably)
  172. +     error ("printing unreadable object #<screen %s 0x%x>",
  173. +            XSTRING (XSCREEN (obj)->name)->data,
  174. +            XFASTINT (XSCREEN (obj)));
  175. +       
  176.         strout ("#<screen ", -1, printcharfun);
  177.         strout (XSTRING (XSCREEN (obj)->name)->data, -1, printcharfun);
  178.         sprintf (buf, " 0x%x", XFASTINT (XSCREEN (obj)));
  179. ***************
  180. *** 830,835 ****
  181. --- 884,892 ----
  182.   #endif /* MULTI_SCREEN */
  183.   
  184.       case Lisp_Marker:
  185. +       if (print_readably)
  186. +     error ("printing unreadable object #<marker>");
  187. +       
  188.         strout ("#<marker ", -1, printcharfun);
  189.         if (!(XMARKER (obj)->buffer))
  190.       strout ("in no buffer", -1, printcharfun);
  191. ***************
  192. *** 845,850 ****
  193. --- 902,911 ----
  194.   #endif /* standalone */
  195.   
  196.       case Lisp_Subr:
  197. +       if (print_readably)
  198. +     error ("printing unreadable object #<subr %s>",
  199. +            XSUBR (obj)->symbol_name);
  200. +       
  201.         strout ("#<subr ", -1, printcharfun);
  202.         strout (XSUBR (obj)->symbol_name, -1, printcharfun);
  203.         PRINTCHAR ('>');
  204. ***************
  205. *** 859,864 ****
  206. --- 920,927 ----
  207.   {
  208.     staticpro (&Qprint_escape_newlines);
  209.     Qprint_escape_newlines = intern ("print-escape-newlines");
  210. +   staticpro (&Qprint_readably);
  211. +   Qprint_readably = intern ("print-readably");
  212.   
  213.     DEFVAR_LISP ("standard-output", &Vstandard_output,
  214.       "Output stream `print' uses by default for outputting a character.\n\
  215. ***************
  216. *** 903,908 ****
  217. --- 966,981 ----
  218.     DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
  219.       "Non-nil means print newlines in strings as backslash-n.");
  220.     print_escape_newlines = 0;
  221. + 
  222. +   DEFVAR_BOOL ("print-readably", &print_readably,
  223. +     "If non-nil, then compiled-function objects will be written with\n#\
  224. + [...] syntax instead of #<byte-code [...]> syntax.  Lists of the form\n\
  225. + (quote -symbol-) will be printed with the more compact representation of\n\
  226. + '-symbol- instead.  Also, an error will be signalled if there is an\n\
  227. + attempt to write out any object whose printed representation is not\n\
  228. + readable (such as things that print in #<...> form).\n\
  229. + Do not SET this variable; bind it instead.");
  230. +   print_readably = 0;
  231.   
  232.     /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
  233.     staticpro (&Vprin1_to_string_buffer);
  234.