[armedbear-cvs] r14434 - trunk/abcl/src/org/armedbear/lisp

[mevenson at common-lisp.net]

Author: mevenson
Date: Tue Mar 12 06:19:54 2013
New Revision: 14434

Log:
Allow "simple" FORMAT invocations on types derived from Gray streams.

With this patch, calls like

    (format GRAY-STREAM "42")

will work on streams derived from Gray streams (like FLEXI-STREAMS).

Modified:
   trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp	Tue Mar 12 06:19:53 2013	(r14433)
+++ trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp	Tue Mar 12 06:19:54 2013	(r14434)
@@ -649,3 +649,21 @@
 |#
 
 (provide 'gray-streams)
+
+;;; Fixup Gray/ANSI stream relations 
+
+(defparameter *sys--stream-charpos* #'sys::stream-charpos)
+(defun sys::stream-charpos (stream)
+  (cond         
+    ((subtypep (type-of stream) 'gray-streams:fundamental-stream)
+     (stream-line-column stream))
+    ((streamp stream)
+     (funcall *sys--stream-charpos* stream))))
+
+(defparameter *sys--stream-%set-charpos* #'sys::stream-%set-charpos)
+(defun sys::stream-%set-charpos (new-value stream)
+  (cond 
+    ((subtypep (type-of stream) 'gray-streams:fundamental-stream)
+     (setf (stream-line-column stream) new-value))
+    ((streamp stream)
+     (sys::stream-%set-charpos stream new-value))))