(in-package #:system)

;; call print-object when printing clos instances

#+abcl
(if (< SYSTEM:*FASL-VERSION* 35)
    (defun output-ugly-object (object stream)
      (cond ((consp object)
	     (output-list object stream))
	    ((and (vectorp object)
		  (not (stringp object))
		  (not (bit-vector-p object)))
	     (output-vector object stream))
	    ((structure-object-p object)
	     (print-object object stream))
	    ;; patch  
	    ((and (typep object 'standard-object) (not (typep object 'condition)))
	     (print-object object stream))
	    ;; end patch
	    ((xp::xp-structure-p stream)
	     (let ((s (sys::%write-to-string object)))
	       (xp::write-string++ s stream 0 (length s))))
	    (t
	     (%output-object object stream)))))

(if (>= SYSTEM:*FASL-VERSION* 35)
    (progn
;; not needed as of r12389
;; (defmethod print-object ((obj java::java-object) stream) 
;; 	(print-unreadable-object (obj stream :identity t)
;; 	  (let ((tostring (#"toString" obj)))
;; 	    (if (> (length tostring) 32)
;; 		(format stream "~a ~a..." (java::jclass-name (java::jobject-class obj))  (subseq tostring 0 32) stream)
;; 		(format stream "~a ~a" (java::jclass-name (java::jobject-class obj)) tostring stream)))))
      ;; (defun output-ugly-object (object stream)
;; 	(cond ((consp object)
;; 	       (output-list object stream))
;; 	      ((and (vectorp object)
;; 		    (not (stringp object))
;; 		    (not (bit-vector-p object)))
;; 	       (output-vector object stream))
;; 	      ((structure-object-p object)
;; 	       (cond
;; 		 ((and (null *print-readably*)
;; 		       *print-level*
;; 		       (>= *current-print-level* *print-level*))
;; 		  (write-char #\# stream))
;; 		 (t
;; 		  (print-object object stream))))
;; 	      ((standard-object-p object)
;; 	       (print-object object stream))
;; 	      ((java::java-object-p object)
;; 	       (print-object object stream))
;; 	      ((xp::xp-structure-p stream)
;; 	       (let ((s (sys::%write-to-string object)))
;; 		 (xp::write-string++ s stream 0 (length s))))
;; 	      (t
;; 	       (%output-object object stream))))
;; not needed as of r12389
;;       (defvar cl-user::*early-advise-forms* nil)
;;             (push '(:advise sys::frame-to-string 
;; 		    (if (typep (car (:arglist)) 'system::lisp-stack-frame)
;; 			(prin1-to-string 
;; 			 (sys::frame-to-list (car (:arglist))))
;; 			(:do-it)
;; 			)
;; 		    :when :around
;; 		    :name :freedom)
;; 	    cl-user::*early-advise-forms*)
      ))