[gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/numbering.lisp

Robert Strandh rstrandh at common-lisp.net
Thu Aug 5 06:31:57 UTC 2004


Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv24928

Modified Files:
	buffer.lisp numbering.lisp 
Log Message:
Finished factoring out code to initialize parent slots from readers to 
:after methods of initialize-instance. 

Fixed a bug in numbering.lisp, where :after method specilized on 
layer instead of nlayer. 

Date: Wed Aug  4 23:31:57 2004
Author: rstrandh

Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.8 gsharp/buffer.lisp:1.9
--- gsharp/buffer.lisp:1.8	Wed Aug  4 22:58:43 2004
+++ gsharp/buffer.lisp	Wed Aug  4 23:31:57 2004
@@ -636,6 +636,12 @@
    (tail :initarg :tail :accessor tail))
   (:default-initargs :name "default layer"))
 
+(defmethod initialize-instance :after ((l layer) &rest args)
+  (declare (ignore args))
+  (setf (layer (head l)) l
+	(layer (body l)) l
+	(layer (tail l)) l))
+
 (defmethod print-object :after ((l layer) stream)
   (with-slots (head body tail staves) l
     (format stream ":staves ~W :head ~W :body ~W :tail ~W "
@@ -664,12 +670,7 @@
   
 (defun read-melody-layer-v3 (stream char n)
   (declare (ignore char n))
-  (let* ((rest (read-delimited-list #\] stream t))
-	 (layer (apply #'make-instance 'melody-layer rest)))
-    (setf (slot-value (head layer) 'layer) layer
-	  (slot-value (body layer) 'layer) layer
-	  (slot-value (tail layer) 'layer) layer)
-    layer))
+  (apply #'make-instance 'melody-layer (read-delimited-list #\] stream t)))
 
 (set-dispatch-macro-character #\[ #\_
   #'read-melody-layer-v3
@@ -698,12 +699,7 @@
 
 (defun read-lyrics-layer-v3 (stream char n)
   (declare (ignore char n))
-  (let* ((rest (read-delimited-list #\] stream t))
-	 (layer (apply #'make-instance 'lyrics-layer rest)))
-    (setf (slot-value (head layer) 'layer) layer
-	  (slot-value (body layer) 'layer) layer
-	  (slot-value (tail layer) 'layer) layer)
-    layer))
+  (apply #'make-instance 'lyrics-layer (read-delimited-list #\] stream t)))
 
 (set-dispatch-macro-character #\[ #\M
   #'read-lyrics-layer-v3
@@ -784,6 +780,11 @@
    (buffer :initform nil :initarg :buffer :accessor buffer)
    (layers :initform '() :initarg :layers :accessor layers)))
 
+(defmethod initialize-instance :after ((s segment) &rest args)
+  (declare (ignore args))
+  (loop for layer in (layers s)
+	do (setf (segment layer) s)))
+
 (defmethod print-object :after ((s segment) stream)
   (format stream ":layers ~W " (layers s)))
 
@@ -797,11 +798,7 @@
 
 (defun read-segment-v3 (stream char n)
   (declare (ignore char n))
-  (let* ((rest (read-delimited-list #\] stream t))
-	 (segment (apply #'make-instance 'segment rest)))
-    (loop for layer in (layers segment) do
-	  (setf (slot-value layer 'segment) segment))
-    segment))
+  (apply #'make-instance 'segment (read-delimited-list #\] stream t)))
 
 (set-dispatch-macro-character #\[ #\S
   #'read-segment-v3
@@ -892,6 +889,11 @@
    (left-offset :initform *default-left-offset* :initarg :left-offset :accessor left-offset)
    (left-margin :initform *default-left-margin* :initarg :left-margin :accessor left-margin)))
 
+(defmethod initialize-instance :after ((b buffer) &rest args)
+  (declare (ignore args))
+  (loop for segment in (segments b)
+	do (setf (buffer segment) b)))
+
 (defmethod print-object :after ((b buffer) stream)
   (with-slots (staves segments min-width spacing-style right-edge left-offset left-margin) b
     (format stream ":staves ~W :segments ~W :min-width ~W :spacing-style ~W :right-edge ~W :left-offset ~W :left-margin ~W "
@@ -907,11 +909,7 @@
 
 (defun read-buffer-v3 (stream char n)
   (declare (ignore char n))
-  (let* ((rest (read-delimited-list #\] stream t))
-	 (buffer (apply #'make-instance 'buffer rest)))
-    (loop for segment in (segments buffer) do
-	  (setf (slot-value segment 'buffer) buffer))
-    buffer))
+  (apply #'make-instance 'buffer (read-delimited-list #\] stream t)))
 
 (set-dispatch-macro-character #\[ #\B
   #'read-buffer-v3


Index: gsharp/numbering.lisp
diff -u gsharp/numbering.lisp:1.2 gsharp/numbering.lisp:1.3
--- gsharp/numbering.lisp:1.2	Fri Jul 23 09:51:16 2004
+++ gsharp/numbering.lisp	Wed Aug  4 23:31:57 2004
@@ -64,7 +64,7 @@
 (defnclass nlayer layer
   ())
 
-(defmethod initialize-instance :after ((layer layer) &rest args)
+(defmethod initialize-instance :after ((layer nlayer) &rest args)
   (declare (ignore args))
   (setf (number (head layer)) 0
 	(number (body layer)) 1





More information about the Gsharp-cvs mailing list