Merge branch 'no-client'

code/extrinsic/packages.lisp

@@ -2,7 +2,6 @@
   (:use #:common-lisp)
   (:shadow #:*print-pprint-dispatch*
            #:copy-pprint-dispatch
-           #:initialize
            #:pprint-dispatch
            #:pprint-exit-if-list-exhausted
            #:pprint-fill
@@ -21,6 +20,7 @@
            #:extrinsic-client
            #:copy-pprint-dispatch
            #:intrinsic-client
+           #:initialize-inravina
            #:pprint-apply
            #:pprint-argument-list
            #:pprint-array

code/extrinsic/print.lisp

@@ -7,7 +7,7 @@
 
 (setf incless-extrinsic:*client* (make-instance 'extrinsic-client))
 
-(initialize)
+(initialize-inravina)
 
 (defmethod incless:write-object ((client extrinsic-client) object stream)
   (multiple-value-bind (func presentp)

code/interface.lisp

@@ -217,7 +217,7 @@
          (print-pprint-dispatch-var (ensure-symbol '#:*print-pprint-dispatch* intrinsic-pkg))
          (pprint-pop-func (ensure-symbol '#:pprint-pop intrinsic-pkg))
          (pprint-exit-if-list-exhausted-func (ensure-symbol '#:pprint-exit-if-list-exhausted intrinsic-pkg))
-         (initialize-func (ensure-symbol '#:initialize)))
+         (initialize-func (ensure-symbol '#:initialize-inravina)))
     `(progn
        (defmethod make-dispatch-function
            ((client ,client-class) (pattern (eql :client-stream-object)) function rest)

code/intrinsic/packages.lisp

@@ -2,7 +2,7 @@
   (:use #:common-lisp)
   (:export #:*client*
            #:*standard-pprint-dispatch*
-           #:initialize
+           #:initialize-inravina
            #:intrinsic-client
            #:pprint-apply
            #:pprint-argument-list

code/pretty-stream.lisp

@@ -9,12 +9,14 @@
    (next :accessor next
          :initarg :next
          :initform nil
-         :type (or null instruction))
-   (section :accessor section
+         :type (or null instruction))))
+
+(defclass section-instruction (instruction)
+  ((section :accessor section
             :initarg :section
             :type (or null section-start))))
 
-(defclass section-start (instruction)
+(defclass section-start (section-instruction)
   ((depth :accessor depth
           :initarg :depth
           :initform 0
@@ -105,7 +107,7 @@
 (defclass line-tab (tab)
   ())
 
-(defclass section-tab (tab)
+(defclass section-tab (tab section-instruction)
   ())
 
 (defclass relative-tab (tab)
@@ -290,7 +292,8 @@
                    (describe stream *debug-io*))
   (loop for i = (head stream) then (next i)
         while i
-        when (and (typep (section i) 'block-start)
+        when (and (typep i 'section-instruction)
+                  (typep (section i) 'block-start)
                   (null (section-end (section i))))
           do (setf (section i) (section (section i))))
   (prog ((section t)
@@ -701,15 +704,13 @@
   (declare (ignore client))
   (push-instruction (make-instance 'line-tab
                                    :colnum colnum :colinc colinc
-                                   :section (car (sections stream))
                                    :parent (car (blocks stream)))
                     stream))
 
 (defmethod pprint-tab (client (stream pretty-stream) (kind (eql :line-relative)) colnum colinc)
   (declare (ignore client))
   (push-instruction (make-instance 'line-relative-tab
                                    :colnum colnum :colinc colinc
-                                   :section (car (sections stream))
                                    :parent (car (blocks stream)))
                     stream))
 
@@ -733,23 +734,20 @@
   (declare (ignore client))
   (push-instruction (make-instance 'block-indent
                                    :width n
-                                   :section (car (sections stream))
                                    :parent (car (blocks stream)))
                     stream))
 
 (defmethod pprint-indent (client (stream pretty-stream) (relative-to (eql :current)) n)
   (declare (ignore client))
   (push-instruction (make-instance 'current-indent
                                    :width n
-                                   :section (car (sections stream))
                                    :parent (car (blocks stream)))
                     stream))
 
 (defun get-text-buffer (stream &aux (current-tail (tail stream)))
   (value (if (typep current-tail 'text)
              current-tail
              (push-instruction (make-instance 'text
-                                              :section (car (sections stream))
                                               :parent (car (blocks stream)))
                                stream))))
 
@@ -813,7 +811,6 @@
 
 (defmethod pprint-end-logical-block (client (stream pretty-stream) suffix)
   (let ((block-end (make-instance 'block-end
-                                  :section (car (sections stream))
                                   :suffix (parse-fix suffix
                                                      (and (car (blocks stream))
                                                           (newline (car (blocks stream)))))
@@ -827,7 +824,6 @@
     (pop (blocks stream))
     (decf (depth stream))
     (push-instruction block-end stream)
-    ;(write-string suffix stream)
     (process-instructions stream)))
 
 (defun frob-style (stream style &aux (current-tail (tail stream)))
@@ -883,7 +879,6 @@
 (defmethod ngray:stream-advance-to-column ((stream pretty-stream) column)
   (cond ((head stream)
          (push-instruction (make-instance 'advance
-                                          :section (car (sections stream))
                                           :value column
                                           :parent (car (blocks stream)))
                            stream)
@@ -925,7 +920,6 @@
     (if (head stream)
         (push-instruction (make-instance 'style
                                          :value new-style
-                                         :section (car (sections stream))
                                          :parent (car (blocks stream)))
                           stream)
         (setf (stream-style (target stream)) new-style))))

code/shim/packages.lisp

@@ -2,6 +2,6 @@
   (:use #:common-lisp)
   (:export #:*client*
            #:*standard-pprint-dispatch*
-           #:initialize
+           #:initialize-inravina
            #:shim-client
            #:pretty-stream-p))

code/shim/print.lisp

@@ -98,4 +98,4 @@
              (write-char #\space stream))
            (ccl::write-a-frob object stream level list-kludge)))))
 
-(initialize)
+(initialize-inravina)