;;; -*- Mode:Common-Lisp; Package:TICLOS; Base:10; Patch-file:T -*-

;;; Reason: Fix handling of *PRINT-CIRCLE* for CLOS instances appearing more than once.  
;;; [SPR 10635]

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to
;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;; Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;   TEXAS INSTRUMENTS INCORPORATED      
;;;   P.O. BOX 149149, M/S 2151             
;;;   AUSTIN, TEXAS 78714
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Patch file for TI-CLOS version 6.25
;;; Written 10/05/89 19:10:26 by GRAY,
;;; while running on Kelvin from band LOD2
;;; With Inconsistent SYSTEM 6.20, VIRTUAL-MEMORY 6.2, EH 6.5, MAKE-SYSTEM 6.2, MICRONET 6.0,
;;;  LOCAL-FILE 6.1, BASIC-PATHNAME 6.2, NETWORK-SUPPORT-COLD 6.1, BASIC-NAMESPACE 6.4,
;;;  NETWORK-NAMESPACE 6.0, DISK-IO 6.1, DISK-LABEL 6.0, BASIC-FILE 6.4, MAC-PATHNAME 6.0,
;;;  NETWORK-PATHNAME 6.0, Inconsistent COMPILER 6.12, TV 6.15, DATALINK 6.0, CHAOSNET 6.1,
;;;  GC 6.3, MEMORY-AUX 6.0, NVRAM 6.2, SYSLOG 6.2, STREAMER-TAPE 6.4, UCL 6.0, INPUT-EDITOR 6.0,
;;;  METER 6.1, ZWEI 6.5, DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.1,
;;;  DATALINK-DISPLAYS 6.0, FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.3, MAC-PRINTER-TYPES 6.1,
;;;  PRINTER-TYPES 6.2, IMAGEN 6.1, SUGGESTIONS 6.0, MAIL-DAEMON 6.3, MAIL-READER 6.5,
;;;  TELNET 6.0, VT100 6.0, NAMESPACE-EDITOR 6.2, PROFILE 6.2, VISIDOC 6.5, Inconsistent TI-CLOS 6.24,
;;;  CLEH 6.5, IP 3.50, Experimental CLX 6.3, CLUE 6.18, X11M 6.14, Experimental BUG 11.15,
;;;  Experimental DOCUMENTER 701.0,  microcode 430, Band Name: 6.0+Scribe,&c,u430 9/6

;;; BUG REPORT NUMBER:  10635
;;;
;;; PROBLEM:  The following example:
;;;	  (defparameter tt (find-class 't))
;;;	  (defparameter xx `((,tt (,tt a) b)))
;;;	  (let ((*print-circle* t)) (print xx))
;;;	prints:  ((#1=#1# (#1# A) B)) 
;;;	which never shows what the value of #1# is.
;;;
;;; DIAGNOSIS:  This was happening because *PRINT-CIRCLE* was being handled 
;;;	twice; once in (METHOD PRINT-OBJECT :AROUND (STANDARD-OBJECT T)), and 
;;;	again in SYS:PRINT-OBJECT which was called by the primary method.
;;;
;;; SOLUTION:  Change (METHOD PRINT-OBJECT (STANDARD-OBJECT T)) to directly 
;;;	send a :PRINT-SELF message instead of calling SYS:PRINT-OBJECT.
;;;
;;; DEPENDENCIES:  Must follow patch 6.17.

#!C
; From file NEW-PRINT-OBJECT.LISP#> CLOS; Hotel:
#10R TICLOS#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "TICLOS"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: CLOS; NEW-PRINT-OBJECT.#"


;; 10/5/89 DNG - Use :PRINT-SELF instead of SYS:PRINT-OBJECT so that 
;;		*PRINT-CIRCLE* is not handled twice. [SPR 10635]
(defmethod print-object ((pobj standard-object) stream)
  (send pobj :print-self stream (or si:*prindepth* 0) *print-escape*)
  pobj)
))