Return to print.c CVS log

Up to [Apple XNU] / GNUtools / emacs / src

Annotation of GNUtools/emacs/src/print.c, revision 1.1

1.1     ! root        1: /* Lisp object printing and output streams.
        !             2:    Copyright (C) 1985, 1986, 1990 Free Software Foundation, Inc.
        !             3: 
        !             4: This file is part of GNU Emacs.
        !             5: 
        !             6: GNU Emacs is free software; you can redistribute it and/or modify
        !             7: it under the terms of the GNU General Public License as published by
        !             8: the Free Software Foundation; either version 1, or (at your option)
        !             9: any later version.
        !            10: 
        !            11: GNU Emacs is distributed in the hope that it will be useful,
        !            12: but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            13: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            14: GNU General Public License for more details.
        !            15: 
        !            16: You should have received a copy of the GNU General Public License
        !            17: along with GNU Emacs; see the file COPYING.  If not, write to
        !            18: the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
        !            19: 
        !            20: 
        !            21: #include "config.h"
        !            22: #include <stdio.h>
        !            23: #undef NULL
        !            24: #include "lisp.h"
        !            25: 
        !            26: #ifndef standalone
        !            27: #include "buffer.h"
        !            28: #include "window.h"
        !            29: #include "process.h"
        !            30: #include "dispextern.h"
        !            31: #include "termchar.h"
        !            32: #endif /* not standalone */
        !            33: 
        !            34: Lisp_Object Vstandard_output, Qstandard_output;
        !            35: 
        !            36: /* Avoid actual stack overflow in print.  */
        !            37: int print_depth;
        !            38: 
        !            39: /* Maximum length of list to print in full; noninteger means
        !            40:    effectively infinity */
        !            41: 
        !            42: Lisp_Object Vprint_length;
        !            43: 
        !            44: /* Nonzero means print newlines in strings as \n.  */
        !            45: 
        !            46: int print_escape_newlines;
        !            47: 
        !            48: /* Nonzero means print newline before next minibuffer message.
        !            49:    Defined in xdisp.c */
        !            50: 
        !            51: extern int noninteractive_need_newline;
        !            52: #ifdef MAX_PRINT_CHARS
        !            53: static int print_chars;
        !            54: static int max_print;
        !            55: #endif /* MAX_PRINT_CHARS */
        !            56: 
        !            57: /* Low level output routines for charaters and strings */
        !            58: 
        !            59: /* Lisp functions to do output using a stream
        !            60:  must have the stream in a variable called printcharfun
        !            61:  and must start with PRINTPREPARE and end with PRINTFINISH.
        !            62:  Use PRINTCHAR to output one character,
        !            63:  or call strout to output a block of characters.
        !            64:  Also, each one must have the declarations
        !            65:    struct buffer *old = current_buffer;
        !            66:    int old_point = -1, start_point;
        !            67:    Lisp_Object original;
        !            68: */ 
        !            69: 
        !            70: #define PRINTPREPARE \
        !            71:    original = printcharfun; \
        !            72:    if (NULL (printcharfun)) printcharfun = Qt; \
        !            73:    if (XTYPE (printcharfun) == Lisp_Buffer) \
        !            74:      { if (XBUFFER (printcharfun) != current_buffer) Fset_buffer (printcharfun); \
        !            75:        printcharfun = Qnil;}\
        !            76:    if (XTYPE (printcharfun) == Lisp_Marker) \
        !            77:      { if (XMARKER (original)->buffer != current_buffer) \
        !            78:          set_buffer_internal (XMARKER (original)->buffer); \
        !            79:        old_point = point; \
        !            80:        SET_PT (marker_position (printcharfun)); \
        !            81:        start_point = point; \
        !            82:        printcharfun = Qnil;}
        !            83: 
        !            84: #define PRINTFINISH \
        !            85:    if (XTYPE (original) == Lisp_Marker) \
        !            86:      Fset_marker (original, make_number (point), Qnil); \
        !            87:    if (old_point >= 0) \
        !            88:      SET_PT ((old_point >= start_point ? point - start_point : 0) + old_point); \
        !            89:    if (old != current_buffer) \
        !            90:      set_buffer_internal (old)
        !            91: 
        !            92: #define PRINTCHAR(ch) printchar (ch, printcharfun)
        !            93: 
        !            94: /* Index of first unused element of message_buf.  */
        !            95: static int printbufidx;
        !            96: 
        !            97: static void
        !            98: printchar (ch, fun)
        !            99:      unsigned char ch;
        !           100:      Lisp_Object fun;
        !           101: {
        !           102:   Lisp_Object ch1;
        !           103: 
        !           104: #ifdef MAX_PRINT_CHARS
        !           105:   if (max_print)
        !           106:     print_chars++;
        !           107: #endif /* MAX_PRINT_CHARS */
        !           108: #ifndef standalone
        !           109:   if (EQ (fun, Qnil))
        !           110:     {
        !           111:       QUIT;
        !           112:       insert (&ch, 1);
        !           113:       return;
        !           114:     }
        !           115:   if (EQ (fun, Qt))
        !           116:     {
        !           117:       if (noninteractive)
        !           118:        {
        !           119:          putchar (ch);
        !           120:          noninteractive_need_newline = 1;
        !           121:          return;
        !           122:        }
        !           123:       if (echo_area_contents != message_buf || !message_buf_print)
        !           124:        {
        !           125:          echo_area_contents = message_buf;
        !           126:          printbufidx = 0;
        !           127:          message_buf_print = 1;
        !           128:        }
        !           129:       if (printbufidx < screen_width)
        !           130:        message_buf[printbufidx++] = ch;
        !           131:       message_buf[printbufidx] = 0;
        !           132:       return;
        !           133:     }
        !           134: #endif /* not standalone */
        !           135: 
        !           136:   XFASTINT (ch1) = ch;
        !           137:   call1 (fun, ch1);
        !           138: }
        !           139: 
        !           140: static void
        !           141: strout (ptr, size, printcharfun)
        !           142:      char *ptr;
        !           143:      int size;
        !           144:      Lisp_Object printcharfun;
        !           145: {
        !           146:   int i = 0;
        !           147: 
        !           148:   if (EQ (printcharfun, Qnil))
        !           149:     {
        !           150:       insert (ptr, size >= 0 ? size : strlen (ptr));
        !           151: #ifdef MAX_PRINT_CHARS
        !           152:       if (max_print)
        !           153:         print_chars += size >= 0 ? size : strlen(ptr);
        !           154: #endif /* MAX_PRINT_CHARS */
        !           155:       return;
        !           156:     }
        !           157:   if (EQ (printcharfun, Qt))
        !           158:     {
        !           159:       i = size >= 0 ? size : strlen (ptr);
        !           160: #ifdef MAX_PRINT_CHARS
        !           161:       if (max_print)
        !           162:         print_chars += i;
        !           163: #endif /* MAX_PRINT_CHARS */
        !           164:       if (noninteractive)
        !           165:        {
        !           166:          fwrite (ptr, 1, i, stdout);
        !           167:          noninteractive_need_newline = 1;
        !           168:          return;
        !           169:        }
        !           170:       if (echo_area_contents != message_buf || !message_buf_print)
        !           171:        {
        !           172:          echo_area_contents = message_buf;
        !           173:          printbufidx = 0;
        !           174:          message_buf_print = 1;
        !           175:        }
        !           176:       if (i > screen_width - printbufidx)
        !           177:        i = screen_width - printbufidx;
        !           178:       bcopy (ptr, &message_buf[printbufidx], i);
        !           179:       printbufidx += i;
        !           180:       message_buf[printbufidx] = 0;
        !           181:       return;
        !           182:     }
        !           183:   if (size >= 0)
        !           184:     while (i < size)
        !           185:       PRINTCHAR (ptr[i++]);
        !           186:   else
        !           187:     while (ptr[i])
        !           188:       PRINTCHAR (ptr[i++]);
        !           189: }
        !           190: 
        !           191: DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
        !           192:   "Output character CHAR to stream STREAM.\n\
        !           193: STREAM defaults to the value of `standard-output' (which see).")
        !           194:   (ch, printcharfun)
        !           195:      Lisp_Object ch, printcharfun;
        !           196: {
        !           197:   struct buffer *old = current_buffer;
        !           198:   int old_point = -1;
        !           199:   int start_point;
        !           200:   Lisp_Object original;
        !           201: 
        !           202:   if (NULL (printcharfun))
        !           203:     printcharfun = Vstandard_output;
        !           204:   CHECK_NUMBER (ch, 0);
        !           205:   PRINTPREPARE;
        !           206:   PRINTCHAR (XINT (ch));
        !           207:   PRINTFINISH;
        !           208:   return ch;
        !           209: }
        !           210: 
        !           211: write_string (data, size)
        !           212:      char *data;
        !           213:      int size;
        !           214: {
        !           215:   struct buffer *old = current_buffer;
        !           216:   Lisp_Object printcharfun;
        !           217:   int old_point = -1;
        !           218:   int start_point;
        !           219:   Lisp_Object original;
        !           220: 
        !           221:   printcharfun = Vstandard_output;
        !           222: 
        !           223:   PRINTPREPARE;
        !           224:   strout (data, size, printcharfun);
        !           225:   PRINTFINISH;
        !           226: }
        !           227: 
        !           228: write_string_1 (data, size, printcharfun)
        !           229:      char *data;
        !           230:      int size;
        !           231:      Lisp_Object printcharfun;
        !           232: {
        !           233:   struct buffer *old = current_buffer;
        !           234:   int old_point = -1;
        !           235:   int start_point;
        !           236:   Lisp_Object original;
        !           237: 
        !           238:   PRINTPREPARE;
        !           239:   strout (data, size, printcharfun);
        !           240:   PRINTFINISH;
        !           241: }
        !           242: 
        !           243: 
        !           244: #ifndef standalone
        !           245: 
        !           246: temp_output_buffer_setup (bufname)
        !           247:     char *bufname;
        !           248: {
        !           249:   register struct buffer *old = current_buffer;
        !           250:   register Lisp_Object buf;
        !           251: 
        !           252:   Fset_buffer (Fget_buffer_create (build_string (bufname)));
        !           253: 
        !           254:   current_buffer->read_only = Qnil;
        !           255:   Ferase_buffer ();
        !           256: 
        !           257:   XSET (buf, Lisp_Buffer, current_buffer);
        !           258:   specbind (Qstandard_output, buf);
        !           259: 
        !           260:   set_buffer_internal (old);
        !           261: }
        !           262: 
        !           263: Lisp_Object
        !           264: internal_with_output_to_temp_buffer (bufname, function, args)
        !           265:      char *bufname;
        !           266:      Lisp_Object (*function) ();
        !           267:      Lisp_Object args;
        !           268: {
        !           269:   int count = specpdl_ptr - specpdl;
        !           270:   Lisp_Object buf, val;
        !           271: 
        !           272:   record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
        !           273:   temp_output_buffer_setup (bufname);
        !           274:   buf = Vstandard_output;
        !           275: 
        !           276:   val = (*function) (args);
        !           277: 
        !           278:   temp_output_buffer_show (buf);
        !           279: 
        !           280:   unbind_to (count);
        !           281:   return val;
        !           282: }
        !           283: 
        !           284: DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
        !           285:        1, UNEVALLED, 0,
        !           286:   "Binding `standard-output' to buffer named BUFNAME, execute BODY then display that buffer.\n\
        !           287: The buffer is cleared out initially, and marked as unmodified when done.\n\
        !           288: All output done by BODY is inserted in that buffer by default.\n\
        !           289: It is displayed in another window, but not selected.\n\
        !           290: The value of the last form in BODY is returned.\n\
        !           291: If variable `temp-buffer-show-hook' is non-nil, call it at the end\n\
        !           292: to get the buffer displayed.  It gets one argument, the buffer to display.")
        !           293:   (args)
        !           294:      Lisp_Object args;
        !           295: {
        !           296:   struct gcpro gcpro1;
        !           297:   Lisp_Object name;
        !           298:   int count = specpdl_ptr - specpdl;
        !           299:   Lisp_Object buf, val;
        !           300: 
        !           301:   GCPRO1(args);
        !           302:   name = Feval (Fcar (args));
        !           303:   UNGCPRO;
        !           304: 
        !           305:   CHECK_STRING (name, 0);
        !           306:   temp_output_buffer_setup (XSTRING (name)->data);
        !           307:   buf = Vstandard_output;
        !           308: 
        !           309:   val = Fprogn (Fcdr (args));
        !           310: 
        !           311:   temp_output_buffer_show (buf);
        !           312: 
        !           313:   unbind_to (count);
        !           314:   return val;
        !           315: }
        !           316: #endif /* not standalone */
        !           317: 
        !           318: static void print ();
        !           319: 
        !           320: DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
        !           321:   "Output a newline to STREAM (or value of standard-output).")
        !           322:   (printcharfun)
        !           323:      Lisp_Object printcharfun;
        !           324: {
        !           325:   struct buffer *old = current_buffer;
        !           326:   int old_point = -1;
        !           327:   int start_point;
        !           328:   Lisp_Object original;
        !           329: 
        !           330:   if (NULL (printcharfun))
        !           331:     printcharfun = Vstandard_output;
        !           332:   PRINTPREPARE;
        !           333:   PRINTCHAR ('\n');
        !           334:   PRINTFINISH;
        !           335:   return Qt;
        !           336: }
        !           337: 
        !           338: DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
        !           339:   "Output the printed representation of OBJECT, any Lisp object.\n\
        !           340: Quoting characters are printed when needed to make output that `read'\n\
        !           341: can handle, whenever this is possible.\n\
        !           342: Output stream is STREAM, or value of `standard-output' (which see).")
        !           343:   (obj, printcharfun)
        !           344:      Lisp_Object obj, printcharfun;
        !           345: {
        !           346:   struct buffer *old = current_buffer;
        !           347:   int old_point = -1;
        !           348:   int start_point;
        !           349:   Lisp_Object original;
        !           350: 
        !           351: #ifdef MAX_PRINT_CHARS
        !           352:   max_print = 0;
        !           353: #endif /* MAX_PRINT_CHARS */
        !           354:   if (NULL (printcharfun))
        !           355:     printcharfun = Vstandard_output;
        !           356:   PRINTPREPARE;
        !           357:   print_depth = 0;
        !           358:   print (obj, printcharfun, 1);
        !           359:   PRINTFINISH;
        !           360:   return obj;
        !           361: }
        !           362: 
        !           363: /* a buffer which is used to hold output being built by prin1-to-string */
        !           364: Lisp_Object Vprin1_to_string_buffer;
        !           365: 
        !           366: DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 1, 0,
        !           367:   "Return a string containing the printed representation of OBJECT,\n\
        !           368: any Lisp object.  Quoting characters are used when needed to make output\n\
        !           369: that `read' can handle, whenever this is possible.")
        !           370:   (obj)
        !           371:      Lisp_Object obj;
        !           372: {
        !           373:   struct buffer *old = current_buffer;
        !           374:   int old_point = -1;
        !           375:   int start_point;
        !           376:   Lisp_Object original, printcharfun;
        !           377:   struct gcpro gcpro1;
        !           378: 
        !           379:   printcharfun = Vprin1_to_string_buffer;
        !           380:   PRINTPREPARE;
        !           381:   print_depth = 0;
        !           382:   print (obj, printcharfun, 1);
        !           383:   /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
        !           384:   PRINTFINISH;
        !           385:   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
        !           386:   obj = Fbuffer_string ();
        !           387:   GCPRO1 (obj);
        !           388:   Ferase_buffer ();
        !           389:   set_buffer_internal (old);
        !           390:   UNGCPRO;
        !           391:   return obj;
        !           392: }
        !           393: 
        !           394: DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
        !           395:   "Output the printed representation of OBJECT, any Lisp object.\n\
        !           396: No quoting characters are used; no delimiters are printed around\n\
        !           397: the contents of strings.\n\
        !           398: Output stream is STREAM, or value of standard-output (which see).")
        !           399:   (obj, printcharfun)
        !           400:      Lisp_Object obj, printcharfun;
        !           401: {
        !           402:   struct buffer *old = current_buffer;
        !           403:   int old_point = -1;
        !           404:   int start_point;
        !           405:   Lisp_Object original;
        !           406: 
        !           407:   if (NULL (printcharfun))
        !           408:     printcharfun = Vstandard_output;
        !           409:   PRINTPREPARE;
        !           410:   print_depth = 0;
        !           411:   print (obj, printcharfun, 0);
        !           412:   PRINTFINISH;
        !           413:   return obj;
        !           414: }
        !           415: 
        !           416: DEFUN ("print", Fprint, Sprint, 1, 2, 0,
        !           417:   "Output the printed representation of OBJECT, with newlines around it.\n\
        !           418: Quoting characters are printed when needed to make output that `read'\n\
        !           419: can handle, whenever this is possible.\n\
        !           420: Output stream is STREAM, or value of `standard-output' (which see).")
        !           421:   (obj, printcharfun)
        !           422:      Lisp_Object obj, printcharfun;
        !           423: {
        !           424:   struct buffer *old = current_buffer;
        !           425:   int old_point = -1;
        !           426:   int start_point;
        !           427:   Lisp_Object original;
        !           428:   struct gcpro gcpro1;
        !           429: 
        !           430: #ifdef MAX_PRINT_CHARS
        !           431:   print_chars = 0;
        !           432:   max_print = MAX_PRINT_CHARS;
        !           433: #endif /* MAX_PRINT_CHARS */
        !           434:   if (NULL (printcharfun))
        !           435:     printcharfun = Vstandard_output;
        !           436:   GCPRO1 (obj);
        !           437:   PRINTPREPARE;
        !           438:   print_depth = 0;
        !           439:   PRINTCHAR ('\n');
        !           440:   print (obj, printcharfun, 1);
        !           441:   PRINTCHAR ('\n');
        !           442:   PRINTFINISH;
        !           443: #ifdef MAX_PRINT_CHARS
        !           444:   max_print = 0;
        !           445:   print_chars = 0;
        !           446: #endif /* MAX_PRINT_CHARS */
        !           447:   UNGCPRO;
        !           448:   return obj;
        !           449: }
        !           450: 
        !           451: static void
        !           452: print (obj, printcharfun, escapeflag)
        !           453: #ifndef RTPC_REGISTER_BUG
        !           454:      register Lisp_Object obj;
        !           455: #else
        !           456:      Lisp_Object obj;
        !           457: #endif
        !           458:      register Lisp_Object printcharfun;
        !           459:      int escapeflag;
        !           460: {
        !           461:   char buf[30];
        !           462: 
        !           463:   QUIT;
        !           464: 
        !           465:   print_depth++;
        !           466:   if (print_depth > 200)
        !           467:     error ("Apparently circular structure being printed");
        !           468: #ifdef MAX_PRINT_CHARS
        !           469:   if (max_print && print_chars > max_print)
        !           470:     {
        !           471:       PRINTCHAR ('\n');
        !           472:       print_chars = 0;
        !           473:     }
        !           474: #endif /* MAX_PRINT_CHARS */
        !           475: 
        !           476: #ifdef SWITCH_ENUM_BUG
        !           477:   switch ((int) XTYPE (obj))
        !           478: #else
        !           479:   switch (XTYPE (obj))
        !           480: #endif
        !           481:     {
        !           482:     default:
        !           483:       /* We're in trouble if this happens!
        !           484:         Probably should just abort () */
        !           485:       strout ("#<EMACS BUG: INVALID DATATYPE ", -1, printcharfun);
        !           486:       sprintf (buf, "(#o%3o)", (int) XTYPE (obj));
        !           487:       strout (buf, -1, printcharfun);
        !           488:       strout (" Save your buffers immediately and please report this bug>",
        !           489:              -1, printcharfun);
        !           490:       break;
        !           491: 
        !           492:     case Lisp_Int:
        !           493:       sprintf (buf, "%d", XINT (obj));
        !           494:       strout (buf, -1, printcharfun);
        !           495:       break;
        !           496: 
        !           497:     case Lisp_String:
        !           498:       if (!escapeflag)
        !           499:        strout (XSTRING (obj)->data, XSTRING (obj)->size, printcharfun);
        !           500:       else
        !           501:        {
        !           502:          register int i;
        !           503:          register unsigned char *p = XSTRING (obj)->data;
        !           504:          register unsigned char c;
        !           505: 
        !           506:          PRINTCHAR ('\"');
        !           507:          for (i = XSTRING (obj)->size; i > 0; i--)
        !           508:            {
        !           509:              QUIT;
        !           510:              c = *p++;
        !           511:              if (c == '\n' && print_escape_newlines)
        !           512:                {
        !           513:                  PRINTCHAR ('\\');
        !           514:                  PRINTCHAR ('n');
        !           515:                }
        !           516:              else
        !           517:                {
        !           518:                  if (c == '\"' || c == '\\')
        !           519:                    PRINTCHAR ('\\');
        !           520:                  PRINTCHAR (c);
        !           521:                }
        !           522:            }
        !           523:          PRINTCHAR ('\"');
        !           524:        }
        !           525:       break;
        !           526: 
        !           527:     case Lisp_Symbol:
        !           528:       {
        !           529:        register int confusing;
        !           530:        register unsigned char *p = XSYMBOL (obj)->name->data;
        !           531:        register unsigned char *end = p + XSYMBOL (obj)->name->size;
        !           532:        register unsigned char c;
        !           533: 
        !           534:        if (p != end && (*p == '-' || *p == '+')) p++;
        !           535:         if (p == end)
        !           536:          confusing = 0;
        !           537:        else
        !           538:          {
        !           539:            while (p != end && *p >= '0' && *p <= '9')
        !           540:              p++;
        !           541:            confusing = (end == p);
        !           542:          }
        !           543: 
        !           544:        p = XSYMBOL (obj)->name->data;
        !           545:        while (p != end)
        !           546:          {
        !           547:            QUIT;
        !           548:            c = *p++;
        !           549:            if (escapeflag)
        !           550:              {
        !           551:                if (c == '\"' || c == '\\' || c == '\'' || c == ';' || c == '#' ||
        !           552:                    c == '(' || c == ')' || c == ',' || c =='.' || c == '`' ||
        !           553:                    c == '[' || c == ']' || c == '?' || c <= 040 || confusing)
        !           554:                  PRINTCHAR ('\\'), confusing = 0;
        !           555:              }
        !           556:            PRINTCHAR (c);
        !           557:          }
        !           558:       }
        !           559:       break;
        !           560: 
        !           561:     case Lisp_Cons:
        !           562:       PRINTCHAR ('(');
        !           563:       {
        !           564:        register int i = 0;
        !           565:        register int max = 0;
        !           566: 
        !           567:        if (XTYPE (Vprint_length) == Lisp_Int)
        !           568:          max = XINT (Vprint_length);
        !           569:        while (CONSP (obj))
        !           570:          {
        !           571:            if (i++)
        !           572:              PRINTCHAR (' ');
        !           573:            if (max && i > max)
        !           574:              {
        !           575:                strout ("...", 3, printcharfun);
        !           576:                break;
        !           577:              }
        !           578:            print (Fcar (obj), printcharfun, escapeflag);
        !           579:            obj = Fcdr (obj);
        !           580:          }
        !           581:       }
        !           582:       if (!NULL (obj) && !CONSP (obj))
        !           583:        {
        !           584:          strout (" . ", 3, printcharfun);
        !           585:          print (obj, printcharfun, escapeflag);
        !           586:        }
        !           587:       PRINTCHAR (')');
        !           588:       break;
        !           589: 
        !           590:     case Lisp_Vector:
        !           591:       PRINTCHAR ('[');
        !           592:       {
        !           593:        register int i;
        !           594:        register Lisp_Object tem;
        !           595:        for (i = 0; i < XVECTOR (obj)->size; i++)
        !           596:          {
        !           597:            if (i) PRINTCHAR (' ');
        !           598:            tem = XVECTOR (obj)->contents[i];
        !           599:            print (tem, printcharfun, escapeflag);
        !           600:          }
        !           601:       }
        !           602:       PRINTCHAR (']');
        !           603:       break;
        !           604: 
        !           605: #ifndef standalone
        !           606:     case Lisp_Buffer:
        !           607:       if (NULL (XBUFFER (obj)->name))
        !           608:        strout ("#<killed buffer>", -1, printcharfun);
        !           609:       else if (escapeflag)
        !           610:        {
        !           611:          strout ("#<buffer ", -1, printcharfun);
        !           612:          strout (XSTRING (XBUFFER (obj)->name)->data, -1, printcharfun);
        !           613:          PRINTCHAR ('>');
        !           614:        }
        !           615:       else
        !           616:        strout (XSTRING (XBUFFER (obj)->name)->data, -1, printcharfun);
        !           617:       break;
        !           618: 
        !           619:     case Lisp_Process:
        !           620:       if (escapeflag)
        !           621:        {
        !           622:          strout ("#<process ", -1, printcharfun);
        !           623:          strout (XSTRING (XPROCESS (obj)->name)->data, -1, printcharfun);
        !           624:          PRINTCHAR ('>');
        !           625:        }
        !           626:       else
        !           627:        strout (XSTRING (XPROCESS (obj)->name)->data, -1, printcharfun);
        !           628:       break;
        !           629: 
        !           630:     case Lisp_Window:
        !           631:       strout ("#<window ", -1, printcharfun);
        !           632:       sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number));
        !           633:       strout (buf, -1, printcharfun);
        !           634:       if (!NULL (XWINDOW (obj)->buffer))
        !           635:        {
        !           636:          unsigned char *p = XSTRING (XBUFFER (XWINDOW (obj)->buffer)->name)->data;
        !           637:          strout (" on ", -1, printcharfun);
        !           638:          strout (p, -1, printcharfun);
        !           639:        }
        !           640:       PRINTCHAR ('>');
        !           641:       break;
        !           642: 
        !           643:     case Lisp_Window_Configuration:
        !           644:       strout ("#<window-configuration>", -1, printcharfun);
        !           645:       break;
        !           646: 
        !           647:     case Lisp_Marker:
        !           648:       strout ("#<marker ", -1, printcharfun);
        !           649:       if (!(XMARKER (obj)->buffer))
        !           650:        strout ("in no buffer", -1, printcharfun);
        !           651:       else
        !           652:        {
        !           653:          sprintf (buf, "at %d", marker_position (obj));
        !           654:          strout (buf, -1, printcharfun);
        !           655:          strout (" in ", -1, printcharfun);
        !           656:          strout (XSTRING (XMARKER (obj)->buffer->name)->data, -1, printcharfun);
        !           657:        }
        !           658:       PRINTCHAR ('>');
        !           659:       break;
        !           660: #endif /* standalone */
        !           661: 
        !           662:     case Lisp_Subr:
        !           663:       strout ("#<subr ", -1, printcharfun);
        !           664:       strout (XSUBR (obj)->symbol_name, -1, printcharfun);
        !           665:       PRINTCHAR ('>');
        !           666:       break;
        !           667:     }
        !           668: 
        !           669:   print_depth--;
        !           670: }
        !           671: 
        !           672: void
        !           673: syms_of_print ()
        !           674: {
        !           675:   DEFVAR_LISP ("standard-output", &Vstandard_output,
        !           676:     "Function print uses by default for outputting a character.\n\
        !           677: This may be any function of one argument.\n\
        !           678: It may also be a buffer (output is inserted before point)\n\
        !           679: or a marker (output is inserted and the marker is advanced)\n\
        !           680: or the symbol t (output appears in the minibuffer line).");
        !           681:   Vstandard_output = Qt;
        !           682:   Qstandard_output = intern ("standard-output");
        !           683:   staticpro (&Qstandard_output);
        !           684: 
        !           685:   DEFVAR_LISP ("print-length", &Vprint_length,
        !           686:     "Maximum length of list to print before abbreviating.\
        !           687: `nil' means no limit.");
        !           688:   Vprint_length = Qnil;
        !           689: 
        !           690:   DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
        !           691:     "Non-nil means print newlines in strings as backslash-n.");
        !           692:   print_escape_newlines = 0;
        !           693: 
        !           694:   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
        !           695:   staticpro (&Vprin1_to_string_buffer);
        !           696: 
        !           697:   defsubr (&Sprin1);
        !           698:   defsubr (&Sprin1_to_string);
        !           699:   defsubr (&Sprinc);
        !           700:   defsubr (&Sprint);
        !           701:   defsubr (&Sterpri);
        !           702:   defsubr (&Swrite_char);
        !           703: #ifndef standalone
        !           704:   defsubr (&Swith_output_to_temp_buffer);
        !           705: #endif /* not standalone */
        !           706: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.