Subject: [clisp-list] clisp-2.27 fails to load compiled cmn-objects.lisp

From: John Towler <[email-masked]>
Date: Mon Sep 10 05:52:02 2001

Greetings,
	I am running CLISP on an i386-unknown-netbsdelf1.5.1 (Toshiba
460 CDT).  I ran into problems compiling/loading cmn
(ftp://ftp-ccrma.stanford.edu/pub/Lisp/cmn.tar.gz, my current copy is
dated Aug 27, 2001 ) with CLISP-2.27.
The form that is a problem seems to be:

2. Break CMN[16]> ;;; Evaluate (defclass box-mixin ()
  ((x0 :initarg :x0 :initform 0 :reader x0 :reader box-x0 :type number)
   (y0 :initarg :y0 :initform 0 :reader y0 :reader box-y0 :type number)
   (x1 :initarg :x1 :initform 0 :reader x1 :reader box-x1 :type number)
   (y1 :initarg :y1 :initform 0 :reader y1 :reader box-y1 :type number)))
*** - Y0 does not name a generic function
3. Break CMN[17]> 

The relevant dribble files are at the end along with the source for
cmn-objects.lisp which seems to be the problem.

  I do not understand why this error occurs here.  Cltl2 indicates
that this is the right kind of form for #'defclass.  My understanding
of CLOS is not very great, so perhaps someone else might see the problem.
CLISP-2.24 (nee 2000-03-06) compiles and loads this with no problem,
cmn files load and PS scores are generated.  I am not sure whether the
problem is with the newer CLOS or something else. How ought I to fix
this?

		  Thanks,
		  John Towler

----------
#<OUTPUT BUFFERED FILE-STREAM CHARACTER #P"clisp-2.27-out" @1>
[2]> (lisp-implementation-version)
"2.27 (released 2001-07-17) (built 3208654828) (memory 3208657091)"
[3]> (load "cmn-all" )
;; Loading file /usr/local/src/lisp/cmn/cmn-all.lisp ...
Compiling file /usr/local/src/lisp/cmn/cmn-loop.lisp ...

Compilation of file /usr/local/src/lisp/cmn/cmn-loop.lisp is finished.
The following functions were used but are deprecated:
 GENTEMP
0 errors, 0 warnings
;;  Loading file /usr/local/src/lisp/cmn/cmn-loop.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/cmn-loop.fas is finished.
Compiling file /usr/local/src/lisp/cmn/cmn-init.lisp ...
; (PROGN (DEFPACKAGE :CMN (:USE :LOOP :LISP ...) ...) (IN-PACKAGE :CMN))
; (PUSHNEW :CMN *FEATURES*)
; (DEFVAR *CMN-BINARY-DIRECTORY* "./")
; (DEFVAR *CMN-SOURCE-DIRECTORY* "./")
; (DEFVAR *CMN-VERSION* "Common Music Notation 27-Aug-01")
; (DEFVAR *CMN-NEWS* ...)

Compilation of file /usr/local/src/lisp/cmn/cmn-init.lisp is finished.
0 errors, 0 warnings
;;  Loading file /usr/local/src/lisp/cmn/cmn-init.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/cmn-init.fas is finished.
Compiling file /usr/local/src/lisp/cmn/cmn-utils.lisp ...
; (IN-PACKAGE :CMN)
; (DEFUN RATIOP (N) (AND (NOT (INTEGERP N)) (TYPEP N 'RATIO)))
; (DEFUN DIVIDE (A B) (IF (ZEROP B) (PROGN # A) (/ A B)))
; (DEFUN NOT-RATIONAL (X) (IF (INTEGERP X) X (FORMAT NIL "~,3F" (FLOAT X))))
; (DEFUN LIST-P (LST) (AND LST (LISTP LST)))
; (DEFUN ROTATE-MATRIX (MATRIX ANGLE) (FLET (# #) (LET # #)))
; (DEFUN SCALE-MATRIX (MATRIX X-SCALE Y-SCALE) ...)
; (DEFUN MIRROR-MATRIX (MATRIX) (IF MATRIX (LIST # # # ...) (LIST -1 0 0 ...)))
; (DEFUN FLIP-MATRIX (MATRIX) (IF MATRIX (LIST # # # ...) (LIST 1 0 0 ...)))
; (DEFUN TRUNCATED-MATRIX-MULTIPLY (M1 M2) (LET (# # # # ...) (LIST # # # ...)))
; (DEFUN TRANSFORM-BOX (MAT TV BB) ...)
; (DEFUN CREATION-DATE NIL (FLET (# #) (MULTIPLE-VALUE-BIND # # # #)))
; (DEFVAR SMALLEST-NOTE 0.015625)
; (DEFUN RATIFY-1 (UX) (IF (ZEROP UX) (LIST 0 1) (LET # #)))
; (DEFUN RATIFY (NUM) (IF (FLOATP NUM) (IF # # #) (IF # # #)))
; (DEFUN FRATIFY (NUM) (IF (FLOATP NUM) (APPLY #'/ (RATIFY NUM)) NUM))
; (DEFUN IRATIFY (NUM) (COERCE (APPLY #'/ (RATIFY NUM)) 'RATIONAL))
; (DEFUN PS-LETTERS (LETTERS) (LET (#) (IF TROUBLE # LETTERS)))
; (DEFUN DECIMAL-TO-OCTAL (N &OPTIONAL (NN 0) ...) ...)

Compilation of file /usr/local/src/lisp/cmn/cmn-utils.lisp is finished.
0 errors, 0 warnings
;;  Loading file /usr/local/src/lisp/cmn/cmn-utils.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/cmn-utils.fas is finished.
Compiling file /usr/local/src/lisp/cmn/cmn-objects.lisp ...
; (IN-PACKAGE :CMN)
; (DEFVAR *CMN-DEFAULT-FONT* (LIST "Times-Roman" "Times-Italic" ...))
; (DEFUN NORMAL-FONT NIL (FIRST *CMN-DEFAULT-FONT*))
; (DEFUN ITALIC-FONT NIL (SECOND *CMN-DEFAULT-FONT*))
; (DEFUN BOLD-FONT NIL (THIRD *CMN-DEFAULT-FONT*))
; (DEFUN BOLD-ITALIC-FONT NIL (FOURTH *CMN-DEFAULT-FONT*))
; (DEFVAR *CMN-DEFAULT-FONT-SIZE* 1.0)
; (DEFPARAMETER PREWHITESPACE "                    ")
; (DEFCLASS SELF-ACTING NIL ...)
; (DEFUN MAKE-SELF-ACTING (&KEY ACTION ARGUMENT) ...)
; (DEFMETHOD SELF-ACTING-P ((OBJ SELF-ACTING)) T)
; (DEFMETHOD SELF-ACTING-P ((OBJ T)) NIL)
; (EVAL-WHEN (COMPILE LOAD EVAL) (DEFMACRO DEFERRED-ACTION (NAME) ...))
; (DEFGENERIC COPY (READ-OBJECT &OPTIONAL WRITE-OBJECT))
; (DEFGENERIC DESCRY (OBJECT &OPTIONAL STREAM CONTROLLER))
; (DEFGENERIC DISPLAY (OBJECT CONTAINER SCORE &OPTIONAL JUSTIFYING))
; (DEFGENERIC HOUSE (OBJECT SCORE))
; (DEFGENERIC NOTIFY (CONTROLLER &OPTIONAL OBJECTS))
; (DEFGENERIC IDENTIFY (OBJECT))
; (DEFMETHOD DESCRY (ANYTHING &OPTIONAL STREAM ...) ...)
; (DEFMETHOD IDENTIFY (ANYTHING) ANYTHING)
; (DEFCLASS WRITE-PROTECT NIL NIL)
; (DEFMETHOD WRITE-PROTECTED ((OBJ T)) NIL)
; (DEFMETHOD WRITE-PROTECTED ((OBJ WRITE-PROTECT)) T)
; (DEFCLASS BOX-MIXIN NIL ...)
; (DEFCLASS BOX (BOX-MIXIN) ...)
; (DEFMETHOD BOX-P ((OBJ T)) NIL)
; (DEFMETHOD BOX-P ((OBJ BOX-MIXIN)) T)
; (DEFUN COPY-BOUNDING-BOX (OBJ1 OBJ2) (SETF (BOX-X0 OBJ2) (BOX-X0 OBJ1)) ...)
; (DEFMETHOD COPY ((BOX BOX-MIXIN) &OPTIONAL OBJECT) ...)
; (DEFMETHOD DESCRY ((BOX BOX-MIXIN) &OPTIONAL STREAM ...) ...)
; (DEFMACRO WITH-POSITION (OBJ X0 Y0 ...) ...)
; (DEFMETHOD WIDTH ((BOX BOX-MIXIN)) (- (BOX-X1 BOX) (BOX-X0 BOX)))
; (DEFCLASS MATRIX-MIXIN NIL ((MATRIX :INITARG :MATRIX :INITFORM NIL ...)))
; (DEFCLASS MATRIX (MATRIX-MIXIN) ((MATRIX :ACCESSOR MATRIX)))
; (DEFMETHOD MATRIX-P ((OBJ T)) NIL)
; (DEFMETHOD MATRIX-P ((OBJ MATRIX-MIXIN)) T)
; (DEFUN MAKE-MATRIX NIL (MAKE-INSTANCE 'MATRIX))
; (DEFMETHOD COPY ((MATRIX MATRIX-MIXIN) &OPTIONAL OBJECT) ...)
; (DEFUN IDENTITY-MATRIX-P (OBJECT) (LET (#) (OR # #)))
; (DEFUN INVISIBLE-P (OBJECT) (LET ((MAT #)) (AND MAT (= # 0) (= # 0) ...)))
; (DEFUN INVISIBLE-MATRIX (MAT) (AND MAT (= # 0) (= # 0) (= # 0) (= # 0)))
; (DEFUN TRANSLATE-MATRIX (SCORE OBJECT X0 Y0 ...) (LET (#) (IF BASE # #)))
; (DEFMETHOD DESCRY ((MATRIX MATRIX-MIXIN) &OPTIONAL STREAM ...) ...)
; (DEFUN IDENTIFY-MATRIX (OBJECT) (IF (NOT #) (IF # " (scale 0 0)" #) ""))
; (DEFUN ROTATE (ANGLE) ...)
; (DEFUN SCALE (XSCL YSCL) ...)
; (DEFUN MIRROR NIL ...)
; (DEFVAR MIRRORED (MAKE-SELF-ACTING :ACTION #'(LAMBDA # # ...) ...))
; (DEFUN TRANSFORM (MATR) ...)
; (DEFUN INVISIBLE NIL ...)
; (DEFVAR INVISIBLE (MAKE-SELF-ACTING :ACTION #'(LAMBDA # # ...) ...))
; (DEFCLASS PATTERN-MIXIN NIL ...)
; (DEFCLASS PATTERN (PATTERN-MIXIN) ...)
; (DEFMETHOD COPY ((PATTERN PATTERN-MIXIN) &OPTIONAL OBJECT) ...)
; (DEFMETHOD DESCRY ((PATTERN PATTERN-MIXIN) &OPTIONAL STREAM ...) ...)
; (DEFCLASS WRITE-PROTECTED-MARKS-MIXIN NIL ...)
; (DEFCLASS MARKS-MIXIN (WRITE-PROTECTED-MARKS-MIXIN) ((MARKS :ACCESSOR MARKS)))
; (DEFMETHOD MARKS-P ((OBJ T)) NIL)
; (DEFMETHOD MARKS-P ((OBJ MARKS-MIXIN)) T)
; (DEFMETHOD DESCRY (# &OPTIONAL STREAM ...) ...)
; (DEFMETHOD COPY ((VIS WRITE-PROTECTED-MARKS-MIXIN) &OPTIONAL OBJECT) ...)
; (DEFUN DISPLAY-MARKS (OBJECT SCORE &OPTIONAL ...) ...)
; (DEFMETHOD ADD-TO-MARKS ((ANYTHING WRITE-PROTECTED-MARKS-MIXIN) OBJECTS) ...)
; (DEFUN EDIT-MARK (ANYTHING MARK-IDENTIFIER MARK-EDITOR) (LOOP FOR M IN ...))
; (DEFUN IDENTIFY-MARKS (OBJECT &OPTIONAL FILE) ...)
; (DEFCLASS VISIBLE-MIXIN ...)
; (DEFCLASS VISIBLE (VISIBLE-MIXIN MARKS-MIXIN BOX ...) ...)
; (DEFMETHOD VISIBLE-P ((OBJ T)) NIL)
; (DEFMETHOD VISIBLE-P ((OBJ VISIBLE-MIXIN)) T)
; (DEFMETHOD DESCRY ((VIS VISIBLE-MIXIN) &OPTIONAL STREAM ...) ...)
; (DEFMETHOD COPY ((VIS VISIBLE-MIXIN) &OPTIONAL OBJECT) ...)
; (DEFUN IDENTIFY-VISIBLE (OBJECT &OPTIONAL FILE) ...)
; (DEFUN LAYOUT (VAL) (MAKE-SELF-ACTING :ARGUMENT VAL :ACTION ...))
; (DEFCLASS FONT-MIXIN NIL ...)
; (DEFMETHOD DESCRY ((FNT FONT-MIXIN) &OPTIONAL STREAM ...) ...)
; (DEFMETHOD COPY ((FNT FONT-MIXIN) &OPTIONAL OBJECT) ...)
; (DEFCLASS TEXT (FONT-MIXIN VISIBLE) ...)
; (DEFMETHOD TEXT-P ((OBJ T)) NIL)
; (DEFMETHOD TEXT-P ((OBJ TEXT)) T)
; (DEFMETHOD DESCRY ((TEXT TEXT) &OPTIONAL STREAM ...) ...)
; (DEFMETHOD COPY ((TEXT TEXT) &OPTIONAL OBJECT) ...)
; (DEFUN GLYPH (NUM) ...)
; (DEFUN MAKE-ISO-ENCODED-VERSION (SCORE FONT-NAME NEW-FONT-NAME) ...)
; (DEFERRED-ACTION CENTER)
; (DEFERRED-ACTION FENCES)
; (DEFERRED-ACTION WALLS)
; (DEFERRED-ACTION EXPANDERS)
; (DEFERRED-ACTION X0)
; (DEFERRED-ACTION Y0)
; (DEFERRED-ACTION X1)
; (DEFERRED-ACTION Y1)
; (DEFERRED-ACTION DX)
; (DEFERRED-ACTION DY)
; (DEFERRED-ACTION MATRIX)
; (DEFERRED-ACTION PATTERN)
; (DEFERRED-ACTION COLOR)
; (DEFERRED-ACTION FONT-NAME)
; (DEFERRED-ACTION FONT-SIZE)
; (DEFERRED-ACTION FONT-SCALER)
; (DEFUN UNDERLINED NIL ...)
; (DEFVAR UNDERLINED (UNDERLINED))
; (DEFUN GRAY-SCALE (&OPTIONAL (N 0)) ...)
; (DEFUN SETF-GRAY-SCALE (OBJ N) (SETF (COLOR OBJ) (LIST N N N)))
; (DEFSETF GRAY-SCALE SETF-GRAY-SCALE)
; (DEFUN OUTLINED (&OPTIONAL (N 0)) ...)
; (DEFCLASS ODB-MIXIN NIL ...)
; (DEFCLASS ODB (ODB-MIXIN) ...)
; (DEFMETHOD ODB-P ((OBJ T)) NIL)
; (DEFMETHOD ODB-P ((OBJ ODB-MIXIN)) T)
; (DEFMETHOD DESCRY ((ODB ODB-MIXIN) &OPTIONAL STREAM ...) ...)
; (DEFMETHOD COPY ((ODB ODB-MIXIN) &OPTIONAL OBJECT) ...)
; (DEFMETHOD ONSET (VAL) (MAKE-SELF-ACTING :ARGUMENT VAL :ACTION ...))
; (DEFMETHOD DURATION ((VAL NUMBER)) ...)
; (DEFMETHOD BEAT ((VAL NUMBER)) (MAKE-SELF-ACTING :ARGUMENT VAL :ACTION ...))
; (DEFCLASS STAFF-RELATIVE-MIXIN NIL ...)
; (DEFMETHOD STAFF-RELATIVE-MIXIN-P ((OBJ T)) NIL)
; (DEFMETHOD STAFF-RELATIVE-MIXIN-P ((OBJ STAFF-RELATIVE-MIXIN)) T)
; (DEFMETHOD DESCRY ((STF-Y0 STAFF-RELATIVE-MIXIN) &OPTIONAL STREAM ...) ...)
; (DEFMETHOD COPY ((STF-Y0 STAFF-RELATIVE-MIXIN) &OPTIONAL OBJECT) ...)
; (DEFMETHOD STAFF-Y0 ((BOX BOX-MIXIN)) (BOX-Y0 BOX))
; (DEFERRED-ACTION STAFF-Y0)
; (DEFCLASS THICK-MIXIN NIL ((THICKNESS :INITARG :THICKNESS :INITFORM NIL ...)))
; (DEFCLASS THICK (THICK-MIXIN) ((THICKNESS :ACCESSOR THICKNESS)))
; (DEFMETHOD DESCRY ((THK THICK-MIXIN) &OPTIONAL STREAM ...) ...)
; (DEFMETHOD COPY ((THK THICK-MIXIN) &OPTIONAL OBJECT) ...)
; (DEFERRED-ACTION THICKNESS)
; (DEFCLASS BREATHING-SPACE-MIXIN NIL ...)
; (DEFCLASS BREATHING-SPACE NIL ...)
; (DEFMETHOD DESCRY ((THK BREATHING-SPACE-MIXIN) &OPTIONAL STREAM ...) ...)
; (DEFMETHOD COPY ((THK BREATHING-SPACE-MIXIN) &OPTIONAL OBJECT) ...)
; (DEFERRED-ACTION BREATHING-SPACE)
; (DEFCLASS SCORE-OBJECT-MIXIN (ODB-MIXIN VISIBLE-MIXIN) ...)
; (DEFMETHOD SCORE-OBJECT-P ((OBJ T)) NIL)
; (DEFMETHOD SCORE-OBJECT-P ((OBJ SCORE-OBJECT-MIXIN)) T)
; (DEFCLASS SCORE-OBJECT (SCORE-OBJECT-MIXIN ODB VISIBLE) NIL)
; (DEFUN OBJECT-ADDRESS (OBJECT) ...)
; (DEFMETHOD PRINT-OBJECT ((OBJECT SCORE-OBJECT-MIXIN) STREAM) ...)
; (DEFMETHOD COPY ((OBJ SCORE-OBJECT-MIXIN) &OPTIONAL OBJECT) ...)
; (DEFCLASS SUNDRY-MIXIN (SCORE-OBJECT-MIXIN THICK-MIXIN) ...)
; (DEFCLASS SUNDRY (SUNDRY-MIXIN SCORE-OBJECT THICK) ...)
; (DEFCLASS WRITE-PROTECTED-SUNDRY (WRITE-PROTECT SUNDRY-MIXIN) NIL)
; (DEFMETHOD SUNDRY-P ((OBJ T)) NIL)
; (DEFMETHOD SUNDRY-P ((OBJ SUNDRY-MIXIN)) T)
; (DEFUN MAKE-SUNDRY (&KEY NAME MARK ...) ...)
; (DEFMETHOD DISPLAY ((SUNDRY SUNDRY-MIXIN) NOTE SCORE ...) ...)
; (DEFMETHOD DESCRY ((SUNDRY SUNDRY-MIXIN) &OPTIONAL STREAM ...) ...)
; (DEFMETHOD IDENTIFY ((SUNDRY SUNDRY-MIXIN)) ...)
; (DEFMETHOD COPY ((SUNDRY SUNDRY-MIXIN) &OPTIONAL OBJECT) ...)
; (DEFGENERIC BACKPATCH (MARK))
; (DEFGENERIC BACKPATCH-TIME (MARK OBJ))
; (DEFGENERIC BACKPATCH-START (MARK))
; (DEFMETHOD BACKPATCH (ANYTHING) (DECLARE (IGNORE ANYTHING)) NIL)
; (DEFMETHOD BACKPATCH ((SUNDRY SUNDRY-MIXIN)) NIL)
; (DEFMETHOD BACKPATCH-TIME ((SUNDRY SUNDRY-MIXIN) OBJ) ...)
; (DEFMETHOD BACKPATCH-START (ANYTHING) (DECLARE (IGNORE ANYTHING)) NIL)
; (DEFUN DIRECTION-FROM-NOTE (MARK OUR-NOTE) ...)
; (DEFUN CMN-MARK (OBJ &REST OBJECTS) (LET (#) (LOOP FOR ACT IN ...) NEW-MARK))
; (DEFUN MARK (FUNC NAME &REST ...) ...)
; (DEFMETHOD NOTIFY ((SUNDRY SUNDRY-MIXIN) &OPTIONAL OBJECTS) ...)
; (DEFCLASS PAGE-MIXIN (ODB-MIXIN BOX-MIXIN STAFF-RELATIVE-MIXIN) ...)
; (DEFCLASS WRITE-PROTECTED-PAGE (WRITE-PROTECT PAGE-MIXIN) NIL)
; (DEFCLASS PAGE (PAGE-MIXIN ODB BOX) ((PAGE-SPACE :ACCESSOR PAGE-SPACE)))
; (DEFUN PAGE-MARK NIL (MAKE-INSTANCE 'PAGE))
; (DEFVAR PAGE-MARK (MAKE-INSTANCE 'WRITE-PROTECTED-PAGE))
; (DEFMETHOD PAGE-P ((OBJ T)) NIL)
; (DEFMETHOD PAGE-P ((OBJ PAGE-MIXIN)) T)
; (DEFMETHOD COPY ((PAGE PAGE-MIXIN) &OPTIONAL OBJECT) ...)
; (DEFMETHOD DESCRY ((PAGE PAGE-MIXIN) &OPTIONAL STREAM ...) ...)
; (DEFMETHOD NOTIFY ((PAGE PAGE-MIXIN) &OPTIONAL OBJECTS) ...)
; (DEFMETHOD IDENTIFY ((PAGE PAGE-MIXIN)) "(page-mark)")
; (DEFCLASS LINE-MIXIN (ODB-MIXIN VISIBLE-MIXIN BOX-MIXIN ...) ...)
; (DEFCLASS WRITE-PROTECTED-LINE (WRITE-PROTECT LINE-MIXIN) NIL)
; (DEFCLASS LINE (LINE-MIXIN ODB VISIBLE ...) ...)
; (DEFUN LINE-MARK (&REST ARGS) (LET (#) (LOOP FOR ARG IN ARGS ...) NEW-LINE))
; (DEFVAR LINE-MARK (MAKE-INSTANCE 'WRITE-PROTECTED-LINE))
; (DEFMETHOD LINE-P ((OBJ T)) NIL)
; (DEFMETHOD LINE-P ((OBJ LINE-MIXIN)) T)
; (DEFMETHOD COPY ((LINE LINE-MIXIN) &OPTIONAL OBJECT) ...)
; (DEFMETHOD DESCRY ((LINE LINE-MIXIN) &OPTIONAL STREAM ...) ...)
; (DEFMETHOD NOTIFY ((LINE LINE-MIXIN) &OPTIONAL OBJECTS) ...)
; (DEFMETHOD IDENTIFY ((LINE LINE-MIXIN)) "(line-mark)")
; (DEFUN LINE-BREAK (&REST ARGS) (APPLY #'LINE-MARK ARGS))
; (DEFVAR LINE-BREAK (MAKE-INSTANCE 'WRITE-PROTECTED-LINE))
; (DEFUN PAGE-BREAK NIL (MAKE-INSTANCE 'PAGE))
; (DEFVAR PAGE-BREAK (MAKE-INSTANCE 'WRITE-PROTECTED-PAGE))
; (DEFCLASS SECTION NIL ((DATA :ACCESSOR DATA :INITFORM NIL :INITARG :DATA)))
; (DEFMETHOD SECTION-P ((OBJ T)) NIL)
; (DEFMETHOD SECTION-P ((OBJ SECTION)) T)
; (DEFUN SECTION (&REST ARGS) (MAKE-INSTANCE 'SECTION :DATA ARGS))

Compilation of file /usr/local/src/lisp/cmn/cmn-objects.lisp is finished.
The following functions were used but not defined:
 SCR-SIZE CMN-ERROR G-SEND TAG-P STEM-IS-UP?
0 errors, 0 warnings
;;  Loading file /usr/local/src/lisp/cmn/cmn-objects.fas ...
*** - Y0 does not name a generic function
1. Break CMN[4]> (load :print t :verbose t "cmn-objects.fas")

*** - EVAL/APPLY: keyword T is illegal for #<COMPILED-CLOSURE LOAD>. The possible keywords are 
(:VERBOSE :PRINT :IF-DOES-NOT-EXIST :EXTERNAL-FORMAT :ECHO :COMPILING
 :EXTRA-FILE-TYPES)
2. Break CMN[5]> Abort

1. Break CMN[4]> (load "cmn-objects.fas: :print t :verbose t)

*** - Ctrl-C: User break
2. Break CMN[6]> Abort

1. Break CMN[4]>  (load "cmn-objects.fas" :print t :verbose t)
;;   Loading file cmn-objects.fas ...
#<PACKAGE CMN> 
*CMN-DEFAULT-FONT* 
NORMAL-FONT 
ITALIC-FONT 
BOLD-FONT 
BOLD-ITALIC-FONT 
*CMN-DEFAULT-FONT-SIZE* 
PREWHITESPACE 
WARNING:
Replacing method #<STANDARD-METHOD (#<STANDARD-CLASS SELF-ACTING>)> in #<GENERIC-FUNCTION ACTION>
WARNING:
Replacing method #<STANDARD-METHOD (#<BUILT-IN-CLASS T> #<STANDARD-CLASS SELF-ACTING>)> in #<GENERIC-FUNCTION (SETF ACTION)>
WARNING:
Replacing method #<STANDARD-METHOD (#<STANDARD-CLASS SELF-ACTING>)> in #<GENERIC-FUNCTION ARGUMENT>
WARNING:
Replacing method #<STANDARD-METHOD (#<BUILT-IN-CLASS T> #<STANDARD-CLASS SELF-ACTING>)> in #<GENERIC-FUNCTION (SETF ARGUMENT)>
#<STANDARD-CLASS SELF-ACTING> 
MAKE-SELF-ACTING 
WARNING:
Replacing method #<STANDARD-METHOD (#<STANDARD-CLASS SELF-ACTING>)> in #<GENERIC-FUNCTION SELF-ACTING-P>
#<STANDARD-METHOD (#<STANDARD-CLASS SELF-ACTING>)> 
WARNING:
Replacing method #<STANDARD-METHOD (#<BUILT-IN-CLASS T>)> in #<GENERIC-FUNCTION SELF-ACTING-P>
#<STANDARD-METHOD (#<BUILT-IN-CLASS T>)> 
DEFERRED-ACTION 
#<GENERIC-FUNCTION COPY> 
WARNING:
Removing all methods of #<GENERIC-FUNCTION DESCRY>
#<GENERIC-FUNCTION DESCRY> 
#<GENERIC-FUNCTION DISPLAY> 
#<GENERIC-FUNCTION HOUSE> 
#<GENERIC-FUNCTION NOTIFY> 
WARNING:
Removing all methods of #<GENERIC-FUNCTION IDENTIFY>
#<GENERIC-FUNCTION IDENTIFY> 
#<STANDARD-METHOD (#<BUILT-IN-CLASS T>)> 
#<STANDARD-METHOD (#<BUILT-IN-CLASS T>)> 
#<STANDARD-CLASS WRITE-PROTECT> 
WARNING:
Replacing method #<STANDARD-METHOD (#<BUILT-IN-CLASS T>)> in #<GENERIC-FUNCTION WRITE-PROTECTED>
#<STANDARD-METHOD (#<BUILT-IN-CLASS T>)> 
WARNING:
Replacing method #<STANDARD-METHOD (#<STANDARD-CLASS WRITE-PROTECT>)> in #<GENERIC-FUNCTION WRITE-PROTECTED>
#<STANDARD-METHOD (#<STANDARD-CLASS WRITE-PROTECT>)> 
WARNING:
Replacing method #<STANDARD-METHOD (#<STANDARD-CLASS BOX-MIXIN>)> in #<GENERIC-FUNCTION X0>
WARNING:
Replacing method #<STANDARD-METHOD (#<STANDARD-CLASS BOX-MIXIN>)> in #<GENERIC-FUNCTION BOX-X0>
*** - Y0 does not name a generic function
2. Break CMN[7]> (dribble)
---------------
#<BUFFERED FILE-STREAM CHARACTER #P"clisp-2.24-out" @1>
[2]> (lisp-implementation-type)
"CLISP"
[3]> (lisp-implementation-version)
"2000-03-06 (March 2000)"
[4]> (load "cmn-all" :print t :verbose t)
;; Loading file /usr/local/src/lisp/cmn/cmn-all.lisp ...
"/usr/local/src/lisp/cmn/" 
"/usr/local/src/lisp/cmn/" 
"/usr/local/src/lisp/cmn/" 
Compiling file /usr/local/src/lisp/cmn/cmn-loop.lisp ...

Compilation of file /usr/local/src/lisp/cmn/cmn-loop.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 LOOP-MAKE-SETQ LOOP-DESETQ-INTERNAL LOOP-MAKE-DESETQ LOOP-TASSOC
 LOOP-TRANSLATE LOOP-TRANSLATE-1 LOOP-SIMPLEP LOOP-OUTPUT-GROUP
 LOOP-MAKE-VARIABLE LOOP-HACK-ITERATION LOOP-TMEMBER
 LOOP-OPTIMIZE-DUPLICATED-CODE-ETC LOOP-BIND-BLOCK LOOP-GET-PROGN-1
 INITIAL-VALUE LOOP-DECLARE-VARIABLE LOOP-TYPED-INIT
 VARIABLE-DECLARATIONS LOOP-TEQUAL LOOP-CONSTANTP
 LOOP-MAKE-CONDITIONALIZATION LOOP-PSEUDO-BODY LOOP-GET-PROGN
 LOOP-EMIT-BODY LOOP-CONSTRUCT-RETURN LOOP-GET-FORM LOOP-OPTIONAL-TYPE
 LOOP-MAKE-ITERATION-VARIABLE LOOP-TYPED-ARITH LOOP-CDRIFY
 LOOP-WHEN-IT-VARIABLE LOOP-SIMPLEP-1 LOOP-END-TESTIFY LOOP-MAKE-PSETQ
 LOOP-SEQUENCER LOOP-GATHER-PREPS LOOP-MAYBE-BIND-FORM
 LOOP-NAMED-VARIABLE
The following functions were used but are deprecated:
 GENTEMP
;;  Loading file /usr/local/src/lisp/cmn/cmn-loop.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/cmn-loop.fas is finished.
T 
CMN-COMPILE-AND-LOAD 
Compiling file /usr/local/src/lisp/cmn/cmn-init.lisp ...

Compilation of file /usr/local/src/lisp/cmn/cmn-init.lisp is finished.
0 errors, 0 warnings
;;  Loading file /usr/local/src/lisp/cmn/cmn-init.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/cmn-init.fas is finished.
Compiling file /usr/local/src/lisp/cmn/cmn-utils.lisp ...

Compilation of file /usr/local/src/lisp/cmn/cmn-utils.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 RATIFY-1 RATIOP RATIFY
;;  Loading file /usr/local/src/lisp/cmn/cmn-utils.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/cmn-utils.fas is finished.
Compiling file /usr/local/src/lisp/cmn/cmn-objects.lisp ...

Compilation of file /usr/local/src/lisp/cmn/cmn-objects.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 SCR-SIZE IDENTITY-MATRIX-P INVISIBLE-P MAKE-SELF-ACTING CMN-ERROR
 NORMAL-FONT G-SEND UNDERLINED OBJECT-ADDRESS DISPLAY-MARKS TAG-P
 STEM-IS-UP? LINE-MARK
;;  Loading file /usr/local/src/lisp/cmn/cmn-objects.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/cmn-objects.fas is finished.
Compiling file /usr/local/src/lisp/cmn/cmn0.lisp ...

Compilation of file /usr/local/src/lisp/cmn/cmn0.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 SETF-PROLOG PRINT-IF-CHANGED STYLE-LIST IDENTIFY-SCORE G-DASHED-LINE
 G-LINETO G-RLINETO G-MOVETO G-RMOVETO G-COMMENT G-SET-LINE-WIDTH
 G-SET-COLOR G-DRAW G-PUSH G-POP G-SEND MATRIX-FRONT G-SET-PATTERN
 MATRIX-BACK G-CURVETO G-FILL G-ARC G-HEADER INCHES-TO-PS G-FOOTER
 G-BBOX G-PAGE-NUMBER C-OPEN HEADER CLEAR-BOUNDS FOOTER C-CLOSE
 CLEAR-SCORE RESTORE-CMN-VARS SAVE-CMN-VARS MAKE-TITLE INITIALIZE SYSTEM
 CMN-ERROR DRAWIFY FILTERIFY SLURIFY MARKIFY TIEIFY BEAMIFY JUSTIFY
 PAGIFY LINIFY COMPACTIFY BOXIFY FILLIFY SCORIFY EDIFY
 CHECK-FOR-LEFT-OVERS FINALIZE BRACKET-P BRACE-P STAFF CMN-CLEAR-PIPE
 MAKE-STAFF-NAME AUDIBLE-P RHYTHM-P PAUSE-P TAG-P ACCIDENTAL-P
 DYNAMICS-P NOTIFIABLE COMMENT MOVETO LINETO DRAW BAR-P CMN-PIPE-CONTEXT
 SYSTEM-CONTEXT STAFF-CONTEXT STAFF-DATA-START STAFF-DATA-CONTINUATION
 OWNER-CONTEXT CMN-ERROR-1
;;  Loading file /usr/local/src/lisp/cmn/cmn0.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/cmn0.fas is finished.
Compiling file /usr/local/src/lisp/cmn/cmn-grfx.lisp ...

Compilation of file /usr/local/src/lisp/cmn/cmn-grfx.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 CMN-RECEIVE-SND-1 C-COMMENT C-MATRIX C-PRINT C-LINEWIDTH X-LINE-WIDTH
 D_PENSIZE X-COLOR C-MOVETO C-RMOVETO C-LINETO C-RLINETO G-MOVETO
 G-LINETO G-RLINETO G-RMOVETO C-CURVETO OUTPUT-BEZIER POSITION-X
 POSITION-Y X-CIRCLE C-LINEWIDTHCLEARED G-SET-LINE-WIDTH X-LINETO
 D_LINETO D_MOVETO X-POLYGON X-TEXT PS-TO-X-FONT-NAME G-SET-FONT
 CMN-PCLOSE G-CLEAR-CONTEXT CMN-POPEN X-CLEAR-WINDOW G-SET-COLOR
;;  Loading file /usr/local/src/lisp/cmn/cmn-grfx.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/cmn-grfx.fas is finished.
Compiling file /usr/local/src/lisp/cmn/cmn-glyphs.lisp ...

Compilation of file /usr/local/src/lisp/cmn/cmn-glyphs.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 DRAW-COMMON-TIME DRAW-FLAT DRAW-N
;;  Loading file /usr/local/src/lisp/cmn/cmn-glyphs.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/cmn-glyphs.fas is finished.
Compiling file /usr/local/src/lisp/cmn/cmn1.lisp ...
WARNING in function DISPLAY-GRAPHICS in lines 3764..3777 :
variable GBB is not used.
Misspelled or missing IGNORE declaration?

Compilation of file /usr/local/src/lisp/cmn/cmn1.lisp is finished.
0 errors, 1 warning
The following functions were used but not defined:
 BAR-PRINT-NAME CHECK-FOR-CMN-STORE-TAG UR-BAR BAR REPEAT-DOTS BRACKET
 UR-BRACE UR-CLEF TEXT THE-USUAL-SUSPECTS UR-ACCIDENTAL DRAW-HALF-SIZE
 SIGN-NAME UR-KEY NOTE-SIGN PLACE-OF-NOTE-ON-CLEF UR-METER
 TEXT-TO-NUMERAL FLOATING-NOTE TEXT-DX ALGOL+ UR-TEXT CMN-TEXT UR-PAUSE
 DRAW-GP REST-P CHORD-P REST-MARK STORE-DATA NOTE-P STEM-IS-UP
 MAXIMUM-LINE UR-DYNAMICS TEXT-TO-DYNAMIC-SPACING TEXT-TO-DYNAMIC
 HEAD-LINE DISPLAY-STACCATO DRAW-STACCATO STEM-END DISPLAY-ACCENT
 DISPLAY-LITTLE-SWELL DISPLAY-WEDGE STACCATO-P WHOLE-NOTE-P
 DISPLAY-TENUTO DISPLAY-DOWN-BOW DISPLAY-UP-BOW DISPLAY-DETACHE
 DISPLAY-MARTELE DISPLAY-MARCATO DISPLAY-BARTOK-PIZZICATO DISPLAY-THUMB
 DRAW-BOTH-PARENS DISPLAY-LEFT-HAND-PIZZICATO TENUTO-P
 DISPLAY-NATURAL-HARMONIC STEM-IS-DOWN? DISPLAY-PEDAL DISPLAY-PEDAL-OFF
 DISPLAY-SEGNO DISPLAY-CODA QUARTERS RHYTHM-P DISPLAY-MOUTH-POSITION
 DISPLAY-SWIRL DISPLAY-ORNAMENT DISPLAY-MORDENT ORNAMENT
 DISPLAY-INVERTED-MORDENT DISPLAY-DOUBLE-MORDENT STEM-IS-UP?
 DISPLAY-TURN DISPLAY-SHORT-TRILL DISPLAY-TR DISPLAY-TRILLED-TURN
 PLACE-OF-NOTE-GIVEN-NOTE ONE-OTHER-NOTE DOTS SIGN DISPLAY-TRILL
 DISPLAY-ARPEGGIO ARROW-P DISPLAY-NO-ARPEGGIO DISPLAY-ARROW ARPEGGIO
 AUDIBLE-STEM-DIRECTION NOTE-LINE NOTE-SIZE DRAW-ARROWHEAD-UP
 DRAW-ARROWHEAD-DOWN UR-REHEARSAL-MARK DISPLAY-REHEARSAL-MARK
 NEXT-REHEARSAL-NUMBER NEXT-REHEARSAL-LETTER DISPLAY-MEASURE-MARK
 DISPLAY-FINGERING PITCH DISPLAY-OCTAVE START-OCTAVE
 START-AND-END-OCTAVE END-OCTAVE AUDIBLE-P LINE READ-4-NUMBERS
 INSERT-EPS-FILE DISPLAY-GRAPHICS
;;  Loading file /usr/local/src/lisp/cmn/cmn1.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/cmn1.fas is finished.
Compiling file /usr/local/src/lisp/cmn/cmn2.lisp ...

Compilation of file /usr/local/src/lisp/cmn/cmn2.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 RHYTHM-NAME FACTORIZE HOW-MANY-DOTS HOW-MANY-FLAGS COPY-SLURS COPY-TIES
 DASHED-STEM CAR-MEMBER NOTE-NAME HALVE-DURATION IDENTIFY-STORE-DATA
 SORTED-TIES UR-NOTE DRAW-BREATH-IN DRAW-BREATH-OUT DRAW-AIRY-HEAD
 DRAW-ARROW-UP DRAW-ARROW-DOWN GET-NOTE-HEAD NOTE-SIZE
 NOTE-HEAD-X0-OFFSET TREMOLO-SLASHES SLANT PARANOID MEASURED
 TREMOLO-NOTE MAXIMUM-LENGTH DRAW-BEAMS DRAW-FLAGS
 DISPLAY-NOTE-SLURS-AND-BRACKETS COLLIDER-SIGN-BACKUP
 COLLISION-SIGN-BACKUP GET-STEM-END NOTE-HEAD-Y0-OFFSET DRAW-STEM
 TREMOLO-TYPE DRAW-TREMOLO DRAW-TWO-NOTE-TREMOLO ALIGN-TIED-NOTES CHORD
 STAFF-PITCH-> DISPLACE-CHORD ACCIDENT-CHORD DISPLAY-TIED-CHORD TIE-TYPE
 UR-REST REST-NAME GET-REST REST-COPY RQ GRACE-NOTE CRESCENDO-P TAG-NOTE
 ANNOTATE-BEAM PREPARE-SLUR NOTE PLACE-OF-NOTE-GIVEN-NOTE
 PITCH-TO-NOTE-OCTAVE-AND-ACCIDENTAL FREQ-TO-PITCH ADD-NOTE-TO-STAFF
 FIND-STAFF FREQ-TO-NOTE-OCTAVE-AND-ACCIDENTAL SCORE-RELATIVE-ONSET
 NOT-METERED ADD-DATA-1 SET-STAFF-METER REINITIALIZE-SCORE
 USER-ADD-TO-LEFT-SLURS USER-ADD-TO-RIGHT-SLURS DEAL-WITH-DELAYED-SLURS
 NOTES CHECK-FOR-DELAYED-SLURS MAP-OVER-STAVES CHECK-FOR-CHORDS
 CMN-STORE INIT-CLM-INPUT ADD-NOTE MAKE-NAME-A-STRING FINISH-CLM-INPUT
 SET-CMN-TEMPO IDENTIFY-SCORE
;;  Loading file /usr/local/src/lisp/cmn/cmn2.fas ...
WARNING:
Removing all methods of #<GENERIC-FUNCTION MINIMUM-LINE>
;;  Loading of file /usr/local/src/lisp/cmn/cmn2.fas is finished.
Compiling file /usr/local/src/lisp/cmn/cmn3.lisp ...
WARNING in function #:TOP-LEVEL-FORM-140-1 in lines 1616..1626 :
variable REST is not used.
Misspelled or missing IGNORE declaration?

Compilation of file /usr/local/src/lisp/cmn/cmn3.lisp is finished.
0 errors, 1 warning
The following functions were used but not defined:
 NO-BEAT-SUBDIVISION DISPLAY-BEAT-SUBDIVISION-NUMBER INTEGER-MULTIPLE
 FUNNY-CASE DISPLAY-SUBDIVISION-BRACKET DISPLAY-BRACKETED-NUMBER
 IDENTIFY-BOX DISPLAY-CONNECTED-TEXT JUSTIFY-CONNECTED-TEXT CTX CTY
 TEXT-ALLOTMENT CONNECTED-UR-TEXT TEXT- CONNECTING-PATTERN-LEVEL -TEXT-
 -TEXT CONNECTING-PATTERN LYRIC-CENTER-JUSTIFIED LYRIC-VERSE
 LYRIC-LEFT-JUSTIFIED DISPLAY-GLISSANDO-TO GLISSANDO-TO PUSH-GLISSANDO
 BEGIN-GLISSANDO POP-GLISSANDO END-GLISSANDO-1 END-GLISSANDO
 BEGIN-PORTAMENTO END-PORTAMENTO ADD-GLISSANDO DISPLAY-CRESCENDO
 CRESCENDO PUSH-CRESCENDO PUSH-DIMINUENDO POP-CRESCENDO POP-DIMINUENDO
 BEGIN-CRESCENDO END-CRESCENDO BEGIN-DIMINUENDO END-DIMINUENDO
 DIMINUENDO FIND-TIME-LINE-POSITION-OF DISPLAY-ENDING FIRST-ENDING
 SECOND-ENDING END-PEND END-FIRST-ENDING BEGIN-FIRST-ENDING
 BEGIN-SECOND-ENDING END-SECOND-ENDING OTHER-ENDING USER-ADD-TO-TIES
 PUSH-TIE NEW-TIE TIE-TIE POP-TIE USER-ADD-TO-LEFT-TIES BEGIN-TIE
 USER-ADD-TO-RIGHT-TIES END-TIE FIND-TIE PREPARE-NOTE-TIE DISPLAY-TIE
 SOLVE-BEZIER RESOLVE-TIES MAP-OVER-STAVES TIEIFY-STAFF
 USER-ADD-TO-SLURS PUSH-SLUR NEW-SLUR SLUR-SLUR POP-SLUR
 USER-ADD-TO-LEFT-SLURS USER-ADD-TO-RIGHT-SLURS FIND-SLUR
 MAKE-AND-GET-READY-TO-DISPLAY-SLUR LOWEST-NOTES-SIGN HIGHEST-NOTES-SIGN
 STEM-HEADING UNDER-SLUR-Y OVER-SLUR-Y INFORM-SLUR NXY-SLOPE SET-UP-SLUR
 SLURIFY-OBJECT SLURIFY-STAFF PREPARE-SLUR MAKE-TWO-NOTE-SLUR BOIL-UNDER
 BOIL-OVER MAKE-THREE-NOTE-SLUR MAKE-FOUR-NOTE-SLUR USER-SET-TREMOLO
 UR-TREMOLO TREMOLO POP-TREMOLO PUSH-TREMOLO NEW-TREMOLO TREMOLO-TREMOLO
 USER-ADD-TO-LEFT-TREMOLOS USER-ADD-TO-RIGHT-TREMOLOS DRAW-BEAM
 BALANCED-NOTES LOTS-OF-LEGER-LINES DRAW-BEAMS ANNOTATE-BEAM
 ANNOTATE-BEAM-1 BEAM-ACROSS-LINE-BREAK BEAM-BETWEEN-STAVES FLATTEN
 LOCKED-STEM-DIRECTION STEM-DIRECTIONS-FIT ANALYZE-BEAM FUNCTION-P
 HANDLE-EXPLICIT-BEAMS COLLECT-AND-ANNOTATE-BEAMS IDENTIFY-SLUR
;;  Loading file /usr/local/src/lisp/cmn/cmn3.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/cmn3.fas is finished.
Compiling file /usr/local/src/lisp/cmn/cmn4.lisp ...

Compilation of file /usr/local/src/lisp/cmn/cmn4.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 ABSOLUTELY-TRUE-STAFF STAFF-ENGORGE SYSTEM-ENGORGE MARKIFY-STAFF
 UNCOVER-LINE-OR-PAGE-MEASURE-NUMBERS GET-BACK-STAFF-CLEF FIXUP-LINE
 CHECK-IF-NOTES-COLLIDE FIXUP-GRACE-NOTE-LINE FRACTIONAL-PART
 FILL-OUT-BEAT FILL-OUT-MEASURE FLEQ FEQ FILL-OUT-MEASURES
 SET-OCTAVE-SIGN CHECK-NOTE-FOR-NEEDED-NATURAL
 CHECK-CHORD-FOR-NEEDED-NATURALS SCORE-ENGORGE FIND-OR-INSERT-CLEF
 SET-ODB INSERT-BARS-TIES-AND-RESTS SET-CLEF-Y0-AND-LINES
 INSERT-OCTAVE-SIGNS INSERT-NATURALS INSERT-MEASURE-NUMBERS
 HANDLE-HIDDEN-SECTIONS WALL-LEFT-SPACE WALL-RIGHT-SPACE
 FENCE-LEFT-SPACE FENCE-RIGHT-SPACE EXPAND-LEFT-SPACE EXPAND-RIGHT-SPACE
 SCALE-TLD SURVEY MINIMUM-SPACE MAKE-RIGHT-BAR TOTAL-UP-X-AND-FX
 AMALGAMATE-LINE-DATA LINIFY-WITH-ADDED-BREAKS
 LINIFY-WITHOUT-ADDED-BREAKS SET-UP-LINE-LIST ACTIVE-TIME ACTIVE-STAFF
 ACTIVE-STAVES ACTIVE-SYSTEMS SET-UP-STAFF-TIMES CURRENT-LINE-FIXUP
 LINE-HEIGHT EFFECTIVE-LENGTH ROOM-FOR-STAFF-NAME RX-LENGTH BRACKET-ALSO
 FIND-TIME-LINE-POSITION-OF CHECK-FOR-NAME FIND-LINE-INTERSECTION
 FOUND-STAFF-NAME LAYOUT-LINE LINE-PER-PAGE-FIXUP
 MAXIMUM-STAFF-NAME-ROOM FIXUP-BRACKETS-AND-BRACES NEW-STAFF
 COMPACTIFY-FIRST-ONSET REGULARIZE-TIME-LINE LINE-DATA-X RX-SPACE
 CHECK-STAFF-LIMITS PAGED-FILE-NAMES DISPLAY-PAGE-NUMBER PAGED-FILE-NAME
 EJECT-PAGE ONE-PAGE DRAWIFY TEXT-OF
;;  Loading file /usr/local/src/lisp/cmn/cmn4.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/cmn4.fas is finished.
Compiling file /usr/local/src/lisp/cmn/rqq.lisp ...

Compilation of file /usr/local/src/lisp/cmn/rqq.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 LOCAL-HOW-MANY-DOTS FLATTENIZE GET-TIES FIXUP-TIED-RHYTHMS POW2-P
 TRANSLATE-SUBDIVISION GET-STRUCT-POSITION MASSAGE-RHYS COUNT-NOTES GBD
 LOCAL-RQ GET-EXPLICIT-BEAMS GET-MAX-DEPTH GET-SUBDIVS
The following functions were used but are deprecated:
 GENTEMP SET
;;  Loading file /usr/local/src/lisp/cmn/rqq.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/rqq.fas is finished.
Compiling file /usr/local/src/lisp/cmn/wedge.lisp ...

Compilation of file /usr/local/src/lisp/cmn/wedge.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 DISPLAY-WEDGE-BEAMS UR-BEGIN-WEDGE-BEAM FIXUP-WEDGE-BEAM
 INVISIBLE-SPACER
;;  Loading file /usr/local/src/lisp/cmn/wedge.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/wedge.fas is finished.
Compiling file /usr/local/src/lisp/cmn/accent.lisp ...

Compilation of file /usr/local/src/lisp/cmn/accent.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 SUL- -SUL SUL-TASTO- -SUL-TASTO DISPLAY-FINGERNAIL DISPLAY-TONGUE
 DISPLAY-NAIL-PIZZICATO DISPLAY-MARTELLATO DISPLAY-HAUPTSTIMME
 DISPLAY-NEBENSTIMME DISPLAY-NO-ACCENT DISPLAY-DOINK DISPLAY-RIP
 DISPLAY-SMEAR SPRECHSTIMME CIRCLED-STEM DISPLAY-ORGAN-HEEL
 DISPLAY-ORGAN-TOE DISPLAY-VIBRATO DISPLAY-INVERTED-TURN
;;  Loading file /usr/local/src/lisp/cmn/accent.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/accent.fas is finished.
Compiling file /usr/local/src/lisp/cmn/pedal.lisp ...

Compilation of file /usr/local/src/lisp/cmn/pedal.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 BASIC-PEDAL BASIC-PEDAL- -BASIC-PEDAL- -BASIC-PEDAL UR-PEDAL- PEDAL-
 -UR-PEDAL- -PEDAL- -UR-PEDAL -PEDAL UR-SOST.PED- SOST.PED-
 -UR-SOST.PED- -SOST.PED- -UR-SOST.PED -SOST.PED DISPLAY-SOST.PED
 UR-U.C.PED- U.C.PED- -UR-U.C.PED- -U.C.PED- -UR-U.C.PED -U.C.PED
 DISPLAY-U.C.PED PEDAL-RESTART DISPLAY-ONE-HALF DISPLAY-ANY-PEDAL
;;  Loading file /usr/local/src/lisp/cmn/pedal.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/pedal.fas is finished.
Compiling file /usr/local/src/lisp/cmn/percussion.lisp ...

Compilation of file /usr/local/src/lisp/cmn/percussion.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 DISPLAY-CYMBAL DISPLAY-GONG DISPLAY-MARACAS DISPLAY-TAMBOURINE
 DISPLAY-SUSPENDED-CYMBAL DISPLAY-HI-HAT DISPLAY-TRIANGLE
 DISPLAY-COW-BELLS DISPLAY-BASS-DRUM DISPLAY-HARD-STICK
 DISPLAY-SOFT-STICK DISPLAY-METAL-STICK DISPLAY-RUBBER-STICK
 DISPLAY-WOOD-STICK DISPLAY-WIRE-BRUSH DISPLAY-TRIANGLE-STICK
;;  Loading file /usr/local/src/lisp/cmn/percussion.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/percussion.fas is finished.
Compiling file /usr/local/src/lisp/cmn/ring.lisp ...

Compilation of file /usr/local/src/lisp/cmn/ring.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 DOTTED-P FILLED-BEZIER DISPLAY-RING- DISPLAY--RING UR-RING
 DISPLAY--RING-
;;  Loading file /usr/local/src/lisp/cmn/ring.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/ring.fas is finished.
Compiling file /usr/local/src/lisp/cmn/rests.lisp ...

Compilation of file /usr/local/src/lisp/cmn/rests.lisp is finished.
0 errors, 0 warnings
;;  Loading file /usr/local/src/lisp/cmn/rests.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/rests.fas is finished.
Compiling file /usr/local/src/lisp/cmn/lyrics.lisp ...

Compilation of file /usr/local/src/lisp/cmn/lyrics.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 GATHER-LYRICS LYRIC-LENGTH
;;  Loading file /usr/local/src/lisp/cmn/lyrics.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/lyrics.fas is finished.
Compiling file /usr/local/src/lisp/cmn/transpose.lisp ...

Compilation of file /usr/local/src/lisp/cmn/transpose.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 MAP-SIGNATURE UNMAP-SIGNATURE UPDATE-NOTE-1 KEY-BASE KEY-PITCH
 UPDATE-NOTE UPDATE-KEY KEY-MODE
;;  Loading file /usr/local/src/lisp/cmn/transpose.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/transpose.fas is finished.
Compiling file /usr/local/src/lisp/cmn/pmn.lisp ...

Compilation of file /usr/local/src/lisp/cmn/pmn.lisp is finished.
0 errors, 0 warnings
;;  Loading file /usr/local/src/lisp/cmn/pmn.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/pmn.fas is finished.
Compiling file /usr/local/src/lisp/cmn/quarter.lisp ...

Compilation of file /usr/local/src/lisp/cmn/quarter.lisp is finished.
0 errors, 0 warnings
The following functions were used but not defined:
 DRAW-SHARP-UP DRAW-SHARP-DOWN DRAW-FLAT-UP DRAW-FLAT-DOWN
 DRAW-NATURAL-UP DRAW-NATURAL-DOWN DRAW-FLAT-WITH-DROPOUT
 DRAW-FLAT-WITH-FLAG DRAW-FLAT-REVERSED DRAW-SHARP-HORIZONTAL-MARKS
 DRAW-SHARP-WITH-RIGHT-VERTICAL DRAW-SHARP-WITH-LEFT-VERTICAL
 DRAW-SHARP-WITH-CENTERED-VERTICAL
;;  Loading file /usr/local/src/lisp/cmn/quarter.fas ...
;;  Loading of file /usr/local/src/lisp/cmn/quarter.fas is finished.
NIL 
"/usr/local/src/lisp/cmn/" 
"/usr/local/src/lisp/cmn/" 
;; Loading of file /usr/local/src/lisp/cmn/cmn-all.lisp is finished.
T
[5]> (dribble)
---------------
;;; -*- syntax: common-lisp; package: cmn; base: 10; mode: lisp -*-
;;;

(in-package :cmn)

(defvar *cmn-default-font* (list "Times-Roman" "Times-Italic" "Times-Bold" "Times-BoldItalic"))
;;; this sets all the fallback font names
(defun normal-font () (first *cmn-default-font*))
(defun italic-font () (second *cmn-default-font*))
(defun bold-font () (third *cmn-default-font*))
(defun bold-italic-font () (fourth *cmn-default-font*))
(defvar *cmn-default-font-size* 1.0)

;;; as a convenience for callers of clm, we like to package up all the information about
;;; an entity within the parentheses of that entity -- that is:
;;;    (c4 q staccato (onset 1.5))
;;; which requires that the "onset" function pass its argument on to the "c4" function.
;;; In normal CLOS syntax this would be (setf (onset (c4 q staccato)) 1.5) or something,
;;; and the real entity rapidly gets swallowed up in onion-like layers of setfs with the
;;; associated setf-d data further and further from the field it is setting.  The
;;; functions that act like "onset" above return a "self-acting" instance and the
;;; "self-action" macro wraps up the rest.

(defparameter prewhitespace "                    ")

(defclass self-acting ()
  ((action :initarg :action :initform nil :accessor action)
   (argument :initarg :argument :initform nil :accessor argument)))
  
(defun make-self-acting (&key action argument) (make-instance 'self-acting :action action :argument argument))
(defmethod self-acting-p ((obj self-acting)) t)
(defmethod self-acting-p ((obj t)) nil)

(eval-when (compile load eval)
  (defmacro deferred-action (name)
    `(defmethod ,name ((val t)) (make-self-acting :action #'(lambda (obj val1) (setf (,name obj) val1)) :argument val))))

;;;
;;; ----------------    main methods
;;;

(defgeneric copy (read-object &optional write-object))
(defgeneric descry (object &optional stream controller))
(defgeneric display (object container score &optional justifying))
(defgeneric house (object score))
(defgeneric notify (controller &optional objects))
(defgeneric identify (object))

;;; these are the primary generic functions that every score object responds to
;;; copy returns a copy (unwrite-protected) of its argument (at top level)
;;; descry is our describe method intended for debugging (would be nice if lisp's describe were specializable)
;;; display displays an object
;;; house puts the three layers of white space boxes around an object (during justification)
;;; notify is the syntax checker -- it reads all the arguments collected into an object and regularizes everything
;;; identify is used by the error reporting mechanism to try to give an understandable reference to the current object

(defmethod descry (anything &optional stream controller)
  (declare (ignore controller))
  (format stream " ~A" anything))

(defmethod identify (anything)
  anything)

;;;
;;; ----------------    read-only structures
;;;
;;; our basic score syntax includes such things as (cmn staff treble c4 q) and we have
;;; to make sure we never write the fields of the "staff" or "treble" (etc) variables
;;; so all such special variables are "write-protected".
;;;
;;; This is actually a kludge to get around a PCL bug that (defconstant hi (make-instance...))
;;;   does not return a true constant (i.e. (constantp hi) is NIL) -- in ACL 4.1, and I assume
;;;   any "real" CLOS lisp, the write-protected class is unneeded, but at this point a rewrite
;;;   would be a big undertaking.

(defclass write-protect ()
  ())

;;; using typep as in:
;;;(defun write-protected (object) (typep object 'write-protect))
;;; is about 10 times slower than methods such as:

(defmethod write-protected ((obj t)) nil)
(defmethod write-protected ((obj write-protect)) t)

;;;
;;; ----------------    bounds (the "bounding-box")
;;;
;;; x0 y0 is lower left corner, normally -- some objects slop over one way or the other

(defclass box-mixin ()
  ((x0 :initarg :x0 :initform 0 :reader x0 :reader box-x0 :type number)
   (y0 :initarg :y0 :initform 0 :reader y0 :reader box-y0 :type number)
   (x1 :initarg :x1 :initform 0 :reader x1 :reader box-x1 :type number)
   (y1 :initarg :y1 :initform 0 :reader y1 :reader box-y1 :type number)))

(defclass box (box-mixin)
  ((x0 :accessor x0 :accessor box-x0 :type number)
   (y0 :accessor y0 :accessor box-y0 :type number)
   (x1 :accessor x1 :accessor box-x1 :type number)
   (y1 :accessor y1 :accessor box-y1 :type number)))

(defmethod box-p ((obj t)) nil)
(defmethod box-p ((obj box-mixin)) t)

(defun copy-bounding-box (obj1 obj2)
  (setf (box-x0 obj2) (box-x0 obj1))
  (setf (box-x1 obj2) (box-x1 obj1))
  (setf (box-y0 obj2) (box-y0 obj1))
  (setf (box-y1 obj2) (box-y1 obj1)))

(defmethod copy ((box box-mixin) &optional object)
  (let ((new-box (if (not object) (make-instance 'box)
		   (if (write-protected object) (copy object)
		     object))))
    (setf (box-x0 new-box) (box-x0 box))
    (setf (box-y0 new-box) (box-y0 box))
    (setf (box-x1 new-box) (box-x1 box))
    (setf (box-y1 new-box) (box-y1 box))
    (if (next-method-p) (call-next-method box new-box))
    new-box))

(defmethod descry ((box box-mixin) &optional stream controller)
  (format stream "~A :x0 ~A :y0 ~A :x1 ~A :y1 ~A~A~A"
	  (if (not controller) "(box" "")
	  (not-rational (x0 box))
	  (not-rational (y0 box))
	  (not-rational (x1 box))
	  (not-rational (y1 box))
	  (if (next-method-p) (call-next-method box stream (or controller box)) "")
	  (if (not controller) ")" "")))

(defmacro with-position (obj x0 y0 &body body)
  `(let ((old_x0 (box-x0 ,obj))
	 (old_y0 (box-y0 ,obj)))
     (if (not (numberp ,x0)) (warn "weird argument to with-position: x0: ~A of ~A " ,x0 ,obj))
     (if (write-protected ,obj) (warn "write-protected ~A passed to with-position" ,obj))
     (setf (box-x0 ,obj) ,x0)
     (setf (box-y0 ,obj) ,y0)
     ,@body
     (setf (box-x0 ,obj) old_x0)
     (setf (box-y0 ,obj) old_y0)))

(defmethod width ((box box-mixin))
  (- (box-x1 box) (box-x0 box)))

;;; 
;;; ---------------     patterns and coordinate transformations
;;;

(defclass matrix-mixin ()
  ((matrix :initarg :matrix 
	   :initform nil
	   :reader matrix)))

(defclass matrix (matrix-mixin)
  ((matrix :accessor matrix)))

(defmethod matrix-p ((obj t)) nil)
(defmethod matrix-p ((obj matrix-mixin)) t)
(defun make-matrix () (make-instance 'matrix)) ;backwards compatibility

(defmethod copy ((matrix matrix-mixin) &optional object)
  (let ((new-matrix (if (not object) (make-instance 'matrix)
		      (if (write-protected object) (copy object)
			object))))
    (if (matrix matrix) (setf (matrix new-matrix) (copy-list (matrix matrix))))
    (if (next-method-p) (call-next-method matrix new-matrix))
    new-matrix))

(defun identity-matrix-p (object)
  (let ((mat (matrix object)))
    (or (not mat)
	(and (= (first mat) 1)
	     (= (second mat) 0)
	     (= (third mat) 0)
	     (= (fourth mat) 1)))))

(defun invisible-p (object)
  (let ((mat (matrix object)))
    (and mat
	 (= (first mat) 0)
	 (= (second mat) 0)
	 (= (third mat) 0)
	 (= (fourth mat) 0))))

(defun invisible-matrix (mat)
  (and mat
       (= (first mat) 0)
       (= (second mat) 0)
       (= (third mat) 0)
       (= (fourth mat) 0)))

(defun translate-matrix (score object x0 y0 &optional (scale 1.0))
  (let ((base (if object (copy-list (matrix object)) (list 1 0 0 1 0 0))))
    (if base 
	(progn
	  (setf (first base) (* scale (first base)))
	  (setf (fourth base) (* scale (fourth base)))
	  (setf (fifth base) (* (scr-size score) x0))
	  (setf (sixth base) (* (scr-size score) y0))
	  base)
      (list scale 0 0 scale (* (scr-size score) x0) (* (scr-size score) y0)))))

(defmethod descry ((matrix matrix-mixin) &optional stream controller)
  (format stream "~A~A~A~A"
	  (if (not controller) "(matrix" 
	    (if (not (identity-matrix-p matrix))
		(format nil "~%~A" prewhitespace)
	      ""))
	  (if (not (identity-matrix-p matrix))
	      (format nil " :matrix '~A"
		      (map 'list #'not-rational (matrix matrix)))
	    "")
	  (if (next-method-p) (call-next-method matrix stream (or controller matrix)) "")
	  (if (not controller) ")" "")))

(defun identify-matrix (object)
  (if (not (identity-matrix-p object))
      (if (invisible-p object)
	  " (scale 0 0)"
	(if (equal (matrix object) '(-1 0 0 1 0 0))
	    " mirrored"
	  (if (let ((mobj (matrix object)))
		(and (zerop (second mobj)) (zerop (third mobj)) (zerop (fifth mobj)) (zerop (sixth mobj))))
	      (format nil " (scale ~,3F ~,3F)" (first (matrix object)) (fourth (matrix object)))
	    (format nil " (matrix '~A)" (map 'list #'not-rational (matrix object))))))
    ""))

(defun rotate (angle)
  (make-self-acting :action #'(lambda (obj angle)
				(setf (matrix obj) (rotate-matrix (or (matrix obj) (list 1 0 0 1 0 0)) angle))
				obj)
		    :argument angle))

(defun scale (xscl yscl)
  (make-self-acting :action #'(lambda (obj scls)
				(setf (matrix obj) (scale-matrix (or (matrix obj) (list 1 0 0 1 0 0)) (first scls) (second scls)))
				obj)
		    :argument (list xscl yscl)))
				
(defun mirror ()
  (make-self-acting :action #'(lambda (obj ignored)
				(declare (ignore ignored))
				(setf (matrix obj) (mirror-matrix (or (matrix obj) (list 1 0 0 1 0 0))))
				obj)
		    :argument nil))

(defvar mirrored 
  (make-self-acting :action #'(lambda (obj ignored)
				(declare (ignore ignored))
				(setf (matrix obj) (mirror-matrix (or (matrix obj) (list 1 0 0 1 0 0))))
				obj)
		    :argument nil))

(defun transform (matr)
  (make-self-acting :action #'(lambda (obj matr)
				(setf (matrix obj) (truncated-matrix-multiply (or (matrix obj) (list 1 0 0 1 0 0)) matr))
				obj)
		    :argument matr))

(defun invisible () 
  (make-self-acting :action #'(lambda (obj ignored) 
				(declare (ignore ignored)) 
				(setf (matrix obj) (list 0 0 0 0 0 0)) obj) 
		    :argument nil))

(defvar invisible 
    (make-self-acting :action #'(lambda (obj ignored) 
				  (declare (ignore ignored))
				  (setf (matrix obj) (list 0 0 0 0 0 0)) obj) 
		      :argument nil))

(defclass pattern-mixin ()
  ((pattern-type :initarg :pattern-type :initform nil :reader pattern-type)
   (pattern-data :initarg :pattern-data :initform nil :reader pattern-data)
   (color :initarg :color :initform nil :reader color)))

(defclass pattern (pattern-mixin)
  ((pattern-type :accessor pattern :accessor pattern-type)
   (pattern-data :accessor pattern-data)
   (color :accessor color)))

(defmethod copy ((pattern pattern-mixin) &optional object)
  (let ((new-pattern (if (not object) (make-instance 'pattern)
		       (if (write-protected object) (copy object)
			 object))))
    (setf (pattern-type new-pattern) (pattern-type pattern))
    (setf (pattern-data new-pattern) (pattern-data pattern))
    (setf (color new-pattern) (color pattern))
    (if (next-method-p) (call-next-method pattern new-pattern))
    new-pattern))

(defmethod descry ((pattern pattern-mixin) &optional stream controller)
  (format stream "~A~A~A~A~A~A"
	  (if (not controller) "(pattern" 
	    (if (pattern-type pattern) (format nil "~%~A" prewhitespace)
	      ""))
	  (if (pattern-type pattern)
	      (format nil " :type ~A" (pattern-type pattern))
	    "")
	  (if (pattern-data pattern)
	      (format nil " :data ~A" (pattern-data pattern))
	    "")
	  (if (color pattern)
	      (format nil " :color ~A" (color pattern))
	    "")
	  (if (next-method-p) (call-next-method pattern stream (or controller pattern)) "")
	  (if (not controller) ")" "")))

(defclass write-protected-marks-mixin ()
  ((marks :initarg :marks :initform nil :reader marks)))

(defclass marks-mixin (write-protected-marks-mixin)
  ((marks :accessor marks)))

(defmethod marks-p ((obj t)) nil)
(defmethod marks-p ((obj marks-mixin)) t)

(defmethod descry ((vis write-protected-marks-mixin) &optional stream controller)
  (format stream "~A~A"
	  (if (marks vis) 
	      (format stream "~%~A :marks (list~{ ~A~})"
		      prewhitespace
		      (loop for mark in (marks vis) collect (descry mark stream nil)))
	    "")
	  (if (next-method-p) (call-next-method vis stream (or controller vis)) "")))

(defmethod copy ((vis write-protected-marks-mixin) &optional object)
  (let ((new-vis (if (not object) (make-instance 'marks-mixin)
		   (if (write-protected object) (copy object)
		     object))))
    (if (marks vis) (setf (marks new-vis) (loop for mark in (marks vis) collect (copy mark))))
    (if (next-method-p) (call-next-method vis new-vis))
    new-vis))

(defun display-marks (object score &optional justifying)
  (if (marks object) 
      (loop for mark in (marks object) do 
	(if (or (not (sundry-p mark))
		(not (eq (sundry-name mark) :slur)))
	    (display mark object score justifying)))))

(defmethod add-to-marks ((anything write-protected-marks-mixin) objects) 
  (setf (marks anything) (append (marks anything) objects)))

(defun edit-mark (anything mark-identifier mark-editor)
  (loop for m in (marks anything) do
    (if (funcall mark-identifier m anything)
	(funcall mark-editor m anything))))

(defun identify-marks (object &optional file)
  (if (marks object)
      (format file "~{ ~A~}" 
	      (loop for mark in (marks object)
	       collect (identify mark)))
    ""))

(defclass visible-mixin (write-protected-marks-mixin box-mixin pattern-mixin matrix-mixin)
  ((justification :initform nil :initarg :justification :reader visible-justification)
   (visible-section :initform nil :initarg :visible-section :reader visible-section)
   (dx :initarg :dx :initform 0 :reader dx :reader vis-dx)
   (dy :initarg :dy :initform 0 :reader dy :reader vis-dy)
   (center :initarg :center :initform 0 :reader center)
   (walls :initarg :walls :initform nil :reader walls)
   (fences :initarg :fences :initform nil :reader fences)
   (expanders :initform nil :initarg :expanders :reader expanders)))

(defclass visible (visible-mixin marks-mixin box pattern matrix)
  ((justification :accessor visible-justification :accessor justification)
   (visible-section :accessor visible-section)
   (dx :accessor dx :accessor vis-dx)
   (dy :accessor dy :accessor vis-dy)
   (center :accessor center)
   (walls :accessor walls)
   (fences :accessor fences)
   (expanders :accessor expanders)))

(defmethod visible-p ((obj t)) nil)
(defmethod visible-p ((obj visible-mixin)) t)

(defmethod descry ((vis visible-mixin) &optional stream controller)
  (format stream "~A~A~A~A~A~A~A~A~A"
	  (if (visible-justification vis) 
	      (format stream " :justification :~(~A~)" (visible-justification vis))
	    "")
 	  (if (visible-section vis) 
 	      (format stream " :section ~A" (visible-section vis))
 	    "")
	  (if (not (zerop (dx vis))) (format nil " :dx ~,3F" (dx vis)) "")
	  (if (dy vis)
	      (if (listp (dy vis))
		  (format nil " :dy '~A " (dy vis))
		(if (not (zerop (dy vis))) 
		    (format nil " :dy ~,3F" (dy vis)) 
		  ""))
	    "")
	  (if (and (center vis) (not (zerop (center vis)))) (format nil " :center ~A" (center vis)) "")
	  (if (walls vis) (format nil " :walls '~A" (walls vis)) "")
	  (if (fences vis) (format nil " :fences '~A" (fences vis)) "")
	  (if (expanders vis) (format nil " :expanders '~A" (expanders vis)) "")
	  (if (next-method-p) (call-next-method vis stream (or controller vis)) "")))

(defmethod copy ((vis visible-mixin) &optional object)
  (let ((new-vis (if (not object) 
		     (cmn-error "attempt to copy a bare instance of the visible-mixin class")
		   (if (write-protected object) (copy object)
		     object))))
    (setf (visible-justification new-vis) (visible-justification vis) )
    (setf (visible-section new-vis) (visible-section vis))
    (setf (vis-dx new-vis) (vis-dx vis))
    (setf (vis-dy new-vis) (vis-dy vis))
    (setf (center new-vis) (center vis))
    (setf (walls new-vis) (copy-list (walls vis)))
    (setf (fences new-vis) (copy-list (fences vis)))
    (setf (expanders new-vis) (copy-list (expanders vis)))
    (if (next-method-p) (call-next-method vis new-vis))
    new-vis))

(defun identify-visible (object &optional file)
  (if (or (not (zerop (dx object)))
	  (not (zerop (dy object))))
      (format file "~A~A" 
	      (if (not (zerop (dx object))) (format nil " (dx ~,3F)" (dx object)) "")
	      (if (not (zerop (dy object))) (format nil " (dy ~,3F)" (dy object)) ""))
    ""))

(defun layout (val)
  (make-self-acting :argument val :action #'(lambda (obj arg) (setf (visible-justification obj) arg))))

(defclass font-mixin ()
  ((font-size :initarg :font-size :initform nil :accessor font-size)
   (font-name :initarg :font-name :initform nil :accessor font-name)
   (font-scaler :initarg :font-scaler :initform 1.0 :accessor font-scaler)))

(defmethod descry ((fnt font-mixin) &optional stream controller)
  (format stream "~A~A~A~A~A~A"
	  (if (not controller) "(font" "")
	  (if (font-name fnt) (format nil " :font-name ~A" (font-name fnt)) "")
	  (if (font-size fnt) (format nil " :font-size ~A" (font-size fnt)) "")
	  (if (/= (font-scaler fnt) 1.0) (format nil " :font-scaler ~A" (font-scaler fnt)) "")
	  (if (next-method-p) (call-next-method fnt stream (or controller fnt)) "")
	  (if (not controller) ")" "")))

(defmethod copy ((fnt font-mixin) &optional object)
  (let ((new-fnt (if (not object) (make-instance 'font-mixin)
		   (if (write-protected object) (copy object)
		     object))))
    (setf (font-size new-fnt) (font-size fnt))
    (setf (font-name new-fnt) (font-name fnt))
    (setf (font-scaler new-fnt) (font-scaler fnt))
    (if (next-method-p) (call-next-method fnt new-fnt))
    new-fnt))

(defclass text (font-mixin visible)
  ((letters :initarg :letters :initform nil :accessor letters)
   (y :initarg :y :initform nil :accessor y :accessor text-y)
   (x :initarg :x :initform nil :accessor x :accessor text-x)
   (style :initarg :text-style :initform nil :accessor text-style)
   (font-name :initform (normal-font))
   (justification :initform :none)))

(defmethod text-p ((obj t)) nil)
(defmethod text-p ((obj text)) t)

(defmethod descry ((text text) &optional stream controller)
  (format stream "~A~A~A~A"
	  (if (not controller) "(text" "")
	  (if (letters text) (format nil " :letters ~A" (letters text)) "")
	  (if (text-style text) (format nil " :text-style ~A" (text-style text)) "")
	  (if (next-method-p) (call-next-method text stream (or controller text)) "")
	  (if (not controller) ")" "")))

(defmethod copy ((text text) &optional object)
  (let ((new-text (if (not object) (make-instance 'text)
		    (if (write-protected object) (copy object)
		      object))))
    (setf (letters new-text) (letters text))
    (setf (text-style new-text) (text-style text))
    (setf (text-x new-text) (text-x text))
    (setf (text-y new-text) (text-y text))
    (if (next-method-p) (call-next-method text new-text))
    new-text))

(defun glyph (num)
  (make-self-acting :action #'(lambda (obj num)
				(setf (letters obj) (format nil "\\~O" num))
				obj)
		    :argument num))

(defun make-ISO-encoded-version (score font-name new-font-name)
  (g-send score (format nil
		     " /~A findfont
 dup length dict begin
   {1 index /FID ne {def} {pop pop} ifelse} forall
   /Encoding ISOLatin1Encoding def
   currentdict
 end
 /~A exch definefont pop
" 
		     font-name new-font-name)))

(deferred-action center)
(deferred-action fences)
(deferred-action walls)
(deferred-action expanders)
(deferred-action x0)
(deferred-action y0)
(deferred-action x1)
(deferred-action y1)
(deferred-action dx)
(deferred-action dy)
(deferred-action matrix)
(deferred-action pattern)
(deferred-action color)
(deferred-action font-name)
(deferred-action font-size)
(deferred-action font-scaler)

(defun underlined ()
  (make-self-acting
   :action #'(lambda (obj arg)
	       (declare (ignore arg))
	       (setf (text-style obj) :underlined))
   :argument nil))

(defvar underlined (underlined))

(defun gray-scale (&optional (n 0))
  (make-self-acting
   :action #'(lambda (obj arg)
	       (setf (color obj) (list arg arg arg)))
   :argument n))

(defun setf-gray-scale (obj n)
  (setf (color obj) (list n n n)))

(defsetf gray-scale setf-gray-scale)

(defun outlined (&optional (n 0))
  (make-self-acting
   :action #'(lambda (obj n)
	       (setf (pattern-type obj) :outlined)
	       (setf (pattern-data obj) n))
   :argument n))

;;;
;;; --------------    basic musical time fields (onset/duration/beat=>odb)
;;; 

(defclass odb-mixin ()
  ((onset :initarg :onset :initform nil :reader onset :reader odb-onset)
   (duration :initarg :duration :initform nil :reader duration :reader odb-duration)
   (beat :initarg :beat :initform nil :reader beat :reader odb-beat)))

(defclass odb (odb-mixin)
  ((onset :accessor onset :accessor odb-onset)
   (duration :accessor duration :accessor odb-duration)
   (beat :accessor beat :accessor odb-beat)))

(defmethod odb-p ((obj t)) nil)
(defmethod odb-p ((obj odb-mixin)) t)

(defmethod descry ((odb odb-mixin) &optional stream controller)
  (format stream "~A~A~A~A~A~A"
	  (if (not controller) "(odb" 
	    (if (or (onset odb) (duration odb) (beat odb))
		(format nil "~%~A" prewhitespace)
	      ""))
	  (if (onset odb) (format nil " :onset ~A" (onset odb)) "")
	  (if (duration odb) (format nil " :duration ~A" (duration odb)) "")
	  (if (beat odb) (format nil " :beat ~A" (beat odb)) "")
	  (if (next-method-p) (call-next-method odb stream (or controller odb)) "")
	  (if (not controller) ")" "")))

(defmethod copy ((odb odb-mixin) &optional object)
  (let ((new-object (if (not object) (make-instance 'odb) 
		      (if (write-protected object) (copy object)
			object))))
    (setf (odb-onset new-object) (odb-onset odb))
    (setf (odb-duration new-object) (odb-duration odb))
    (setf (odb-beat new-object) (odb-beat odb))
    (if (next-method-p) (call-next-method odb new-object))
    new-object))

(defmethod onset (val)
  (make-self-acting
   :argument val
   :action #'(lambda (obj arg)
	       (if (numberp arg)
		   (setf (onset obj) (fratify arg))
		 (setf (onset obj) arg)))))

(defmethod duration ((val number))
  (make-self-acting
   :argument val
   :action #'(lambda (obj arg)
	       (setf (duration obj) (fratify arg)))))

(defmethod beat ((val number))
  (make-self-acting
   :argument val
   :action #'(lambda (obj arg)
	       (setf (beat obj) (fratify arg)))))

(defclass staff-relative-mixin ()
  ((staff-y0 :initarg :staff-y0 :initform 0 :accessor staff-y0)))

(defmethod staff-relative-mixin-p ((obj t)) nil)
(defmethod staff-relative-mixin-p ((obj staff-relative-mixin)) t)

(defmethod descry ((stf-y0 staff-relative-mixin) &optional stream controller)
  (format stream "~A~A~A~A"
	  (if (not controller) "(staff-relative-mixin" "")
	  (format nil " :staff-y0 ~A" (staff-y0 stf-y0))
	  (if (next-method-p) (call-next-method stf-y0 stream (or controller stf-y0)) "")
	  (if (not controller) ")" "")))

(defmethod copy ((stf-y0 staff-relative-mixin) &optional object)
  (let ((new-stf (if (not object) (make-instance 'staff-relative-mixin)
		   (if (write-protected object) (copy object)
		     object))))
    (setf (staff-y0 new-stf) (staff-y0 stf-y0))
    (if (next-method-p) (call-next-method stf-y0 new-stf))
    new-stf))

(defmethod staff-y0 ((box box-mixin)) (box-y0 box))

(deferred-action staff-y0)

(defclass thick-mixin ()
  ((thickness :initarg :thickness :initform nil :reader thickness :reader cmn-thickness)))

(defclass thick (thick-mixin)
  ((thickness :accessor thickness)))

(defmethod descry ((thk thick-mixin) &optional stream controller)
  (format stream "~A~A"
	  (if (thickness thk) (format nil " :thickness ~A" (thickness thk)) "")
	  (if (next-method-p) (call-next-method thk stream (or controller thk)) "")))

(defmethod copy ((thk thick-mixin) &optional object)
  (setf (thickness object) (thickness thk))
  (if (next-method-p) (call-next-method thk object))
  object)

(deferred-action thickness)

(defclass breathing-space-mixin ()
  ((breathing-space :initarg :breathing-space :initform 0 :reader breathing-space)))

(defclass breathing-space ()
  ((breathing-space :initarg :breathing-space :initform 0 :accessor breathing-space)))

(defmethod descry ((thk breathing-space-mixin) &optional stream controller)
  (format stream "~A~A"
	  (if (not (zerop (breathing-space thk))) (format nil " :breathing-space ~1,3F" (breathing-space thk)) "")
	  (if (next-method-p) (call-next-method thk stream (or controller thk)) "")))

(defmethod copy ((thk breathing-space-mixin) &optional object)
  (setf (breathing-space object) (breathing-space thk))
  (if (next-method-p) (call-next-method thk object))
  object)

(deferred-action breathing-space)

(defclass score-object-mixin (odb-mixin visible-mixin)
  ((draw-func :initarg :draw-func :accessor draw-func :initform nil)
   (width :initarg :width :accessor width :accessor cmn-width :initform 0)))

(defmethod score-object-p ((obj t)) nil)
(defmethod score-object-p ((obj score-object-mixin)) t)

(defclass score-object (score-object-mixin odb visible)
  ())

;;; anything that the score needs to keep track of (during alignment for example) is a score-object
;;; each such object has a bounding box and a draw function

(defun object-address (object)
  #+mcl   (format nil " #x~x" (ccl:%address-of object))
  ;; can't use excl:pointer-to-fixnum because it is no longer defined in acl 5
  #+excl ""
  #+gcl   (format nil " #o~O" (si:address object))
  #+lucid (format nil " #o~O" (%pointer object))
  #+clisp (format nil " #o~O" (sys::address-of object))
  )

#-excl
(defmethod print-object ((object score-object-mixin) stream)
  (format stream "#<~A~A~A>" 
	  (class-name (class-of object))
	  (object-address object)
	  (if (odb-onset object) (format nil ": (onset ~A)" (odb-onset object)) "")))

(defmethod copy ((obj score-object-mixin) &optional object)
  (let ((new-obj (if (not object) (make-instance 'score-object)
		   (if (write-protected object) (copy object)
		     object))))
    (setf (draw-func new-obj) (draw-func obj))
    (setf (cmn-width new-obj) (cmn-width obj))
    (if (next-method-p) (call-next-method obj new-obj))
    new-obj))

(defclass sundry-mixin (score-object-mixin thick-mixin)
  ((name :initform nil :initarg :name :reader sundry-name)
   (mark :initform nil :initarg :mark :reader sundry-mark)
   (source :initform nil :initarg :source :reader sundry-source)))

(defclass sundry (sundry-mixin score-object thick)
  ((name :accessor sundry-name)
   (mark :accessor sundry-mark)
   (source :accessor sundry-source)))

(defclass write-protected-sundry (write-protect sundry-mixin) ())

(defmethod sundry-p ((obj t)) nil)
(defmethod sundry-p ((obj sundry-mixin)) t)
(defun make-sundry (&key name mark source) (make-instance 'sundry :name name :mark mark :source source))  ;backwards compatibility

(defmethod display ((sundry sundry-mixin) note score &optional justifying)
  (when (or (not justifying)
	    (not (eq (visible-justification sundry) :none)))
    (funcall (sundry-mark sundry) sundry note score justifying)
    (if (marks sundry) (display-marks sundry score justifying))))

(defmethod descry ((sundry sundry-mixin) &optional stream controller)
  (format stream "~A~A~A"
	  (if (tag-p sundry) "" (format stream "(~(~A~)"(sundry-name sundry)))
	  (if (next-method-p) (call-next-method sundry stream (or controller sundry)) "")
	  (if (tag-p sundry) "" ")")))

(defmethod identify ((sundry sundry-mixin))
  (or (sundry-source sundry)
      (and (sundry-name sundry)
	   (not (member (sundry-name sundry) 
			'(:slur :set-up-slur :beat :beat-subdivision :staff-name :beam-between-staves :stem-tie)))
	   (format nil "(~(~A~))" (sundry-name sundry)))
      ""))

(defmethod copy ((sundry sundry-mixin) &optional object)
  (let ((new-sundry (if (not object) (make-instance 'sundry)
		      (if (write-protected object) (copy object)
			object))))
    (setf (sundry-name new-sundry) (sundry-name sundry))
    (setf (sundry-mark new-sundry) (sundry-mark sundry))
    (setf (sundry-source new-sundry) (sundry-source sundry))
    (if (next-method-p) (call-next-method sundry new-sundry))
    new-sundry))

(defgeneric backpatch (mark) )
(defgeneric backpatch-time (mark obj) )
(defgeneric backpatch-start (mark) )

(defmethod backpatch (anything) (declare (ignore anything)) nil)
(defmethod backpatch ((sundry sundry-mixin)) nil)
(defmethod backpatch-time ((sundry sundry-mixin) obj) (declare (ignore obj)) nil)
(defmethod backpatch-start (anything) (declare (ignore anything)) nil)

(defun direction-from-note (mark our-note) 
  (if (member (visible-justification mark) '(:up :above :down :below))
      (if (member (visible-justification mark) '(:up :above)) :up :down)
    (if (stem-is-up? our-note) :down :up)))

(defun cmn-mark (obj &rest objects)
  (let ((new-mark (copy obj)))
    (loop for act in objects do
      (when act
	(if (self-acting-p act)
	    (funcall (action act) new-mark (argument act))
	  (if (visible-p act)
	      (if (write-protected act)
		  (push (copy act) (marks new-mark))
		(push act (marks new-mark)))))))
    new-mark))

(defun mark (func name &rest objects)
  (let ((new-mark (make-instance 'sundry :name name :mark func)))
    (loop for act in objects do
      (when act
	(if (self-acting-p act)
	    (funcall (action act) new-mark (argument act))
	  (if (visible-p act)
	      (if (write-protected act)
		  (push (copy act) (marks new-mark))
		(push act (marks new-mark)))))))
    new-mark))

(defmethod notify ((sundry sundry-mixin) &optional objects)
  (let ((new-mark (copy sundry)))
    (loop for act in objects do
      (when act
	(if (self-acting-p act)
	    (funcall (action act) new-mark (argument act))
	  (if (visible-p act)
	      (push act (marks new-mark))))))
    new-mark))

;;; 
;;; ----------------    line and page marks
;;;
;;; I originally used the slot names "space" and "type", but both are apparently illegal in cltl2!!

(defclass page-mixin (odb-mixin box-mixin staff-relative-mixin) 
  ((page-space :reader page-space :initarg :space :initform nil)))

(defclass write-protected-page (write-protect page-mixin) ())

(defclass page (page-mixin odb box)
  ((page-space :accessor page-space)))

(defun page-mark () (make-instance 'page))
(defvar page-mark (make-instance 'write-protected-page))

(defmethod page-p ((obj t)) nil)
(defmethod page-p ((obj page-mixin)) t)

(defmethod copy ((page page-mixin) &optional object)
  (let ((new-page (if (not object) (make-instance 'page)
		    (if (write-protected object) (copy object)
		      object))))
    (setf (page-space new-page) (page-space page))
    (if (next-method-p) (call-next-method page new-page))
    new-page))

(defmethod descry ((page page-mixin) &optional stream controller)
  (format stream "(page-mark~A~A)" 
	  (if (page-space page) (format nil " :space ~1,3F" (page-space page)) "")
	  (if (next-method-p) (call-next-method page stream (or controller page)) "")))

(defmethod notify ((page page-mixin) &optional objects)
  (declare (ignore objects))
  (if (write-protected page) 
      (make-instance 'page) 
    page))

(defmethod identify ((page page-mixin))
  "(page-mark)")

(defclass line-mixin (odb-mixin visible-mixin box-mixin staff-relative-mixin)
  ((line-space :reader line-space :initarg :space :initform nil)
   (size :reader size :initarg :size :initform nil)
   (line-type :reader line-type :initarg :type :initform nil)
   (line-staff :reader line-staff :initarg :line-staff :initform 0)))

(defclass write-protected-line (write-protect line-mixin) ())

(defclass line (line-mixin odb visible box)
  ((line-space :accessor line-space)
   (size :accessor size)
   (line-type :accessor line-type)
   (line-staff :accessor line-staff)))

(defun line-mark (&rest args) 
  (let ((new-line (make-instance 'line)))
    (loop for arg in args do
      (if (self-acting-p arg)
	  (funcall (action arg) new-line (argument arg))))
    new-line))

(defvar line-mark (make-instance 'write-protected-line))

(defmethod line-p ((obj t)) nil)
(defmethod line-p ((obj line-mixin)) t)

(defmethod copy ((line line-mixin) &optional object)
  (let ((new-line (if (not object) (make-instance 'line)
		    (if (write-protected object) (copy object)
		      object))))
    (setf (size new-line) (size line))
    (setf (line-space new-line) (line-space line))
    (setf (line-type new-line) (line-type line))
    (setf (line-staff new-line) (line-staff line))
    (if (next-method-p) (call-next-method line new-line))
    new-line))

(defmethod descry ((line line-mixin) &optional stream controller)
  (format stream "(line-mark~A~A~A~A~A~A~A)"
	  (if (listp (vis-dx line)) (format nil " :dx ~A" (dx line)) "")
	  (if (or (listp (vis-dy line)) (not (zerop (vis-dy line)))) (format nil " :dy ~A" (vis-dy line)) "")
	  (if (size line) (format nil " :size ~1,3F" (size line)) "")
	  (if (line-space line) (format nil " :space ~1,3F" (line-space line)) "")
	  (if (line-type line) (format nil " :type :~(~A~)" (line-type line)) "")
	  (if (line-staff line) (format nil " :staff-number ~D" (line-staff line)) "")
	  (if (next-method-p) (call-next-method line stream (or controller line)) "")))

(defmethod notify ((line line-mixin) &optional objects)
  (declare (ignore objects))
  (if (write-protected line) 
      (make-instance 'line) 
    line))

(defmethod identify ((line line-mixin))
  "(line-mark)")			;not actually called (line-marks are implicit in staff data structure)

;;; if (dy num) => set dy to (line-number :dy '((staff-number num))) else (dy (staff-number num)) => same listified
;;; else (dy '((staff num) (staff num))).
;;; (dx '((beat num) ...))

(defun line-break (&rest args) (apply #'line-mark args))
(defvar line-break (make-instance 'write-protected-line))
(defun page-break () (make-instance 'page))
(defvar page-break (make-instance 'write-protected-page))

;;; (cmn treble c4 q c4 q c4 q (line-break (dy -1)) c4 q c4 q c4 q (line-mark (dy -2)) c4 q c4 q c4 q)

;;;
;;; ----------------    section
;;;
;;; a section is a group of systems (staves) with auxiliary local score actions

(defclass section () ((data :accessor data :initform nil :initarg :data)))
(defmethod section-p ((obj t)) nil)
(defmethod section-p ((obj section)) t)

(defun section (&rest args)
  (make-instance 'section :data args))

#|
(cmn (section (redundant-accidentals nil) (staff treble (meter 4 4) cs4 q cs4 q cs4 q cs4 q)) 
     (section (staff treble cs4 q cs4 q cs4 q cs4 q)) )
|#

---

From: Sam Steingold <[email-masked]>
Date: Mon Sep 10 06:39:02 2001

> * In message <[email-masked]>
> * On the subject of "[clisp-list] clisp-2.27 fails to load compiled cmn-objects.lisp"
> * Sent on Mon, 10 Sep 2001 05:42:24 -0500
> * Honorable John Towler <[email-masked]> writes:
>

-----------------------------------------
> (describe 'y0)
 
y0 is the symbol y0, lies in #<package posix>, is accessible in the packages COMMON-LISP-USER, EXT, FFI, POSIX, SCREEN, SYSTEM, names a function.
 
 #<package posix> is the package named POSIX.
 It imports the external symbols of the package COMMON-LISP and exports 80 symbols to the package EXT.
 
 #<system-function y0> is a built-in system function.
 Argument list: (arg0)
-----------------------------------------

y0 is the Bessel function.
as such, it is not a generic function, so it cannot be used as :reader.

the package system is your friend; just
        (shadow '(y0 y1))
and you are in good shape.

-- 
Sam Steingold (http://www.podval.org/~sds)
Support Israel's right to defend herself! <http://www.i-charity.com/go/israel>
Read what the Arab leaders say to their people on <http://www.memri.org/>
My other CAR is a CDR.

---

From: Fernando Pablo Lopez-Lezcano <[email-masked]>
Date: Mon Sep 10 10:46:03 2001

> *** - Y0 does not name a generic function

One datapoint...
CLISP-2.27 under linux (redhat 7 plus patches) can compile and
load today's cmn.tar.gz (same date as yours) with no problems.
I get some warnings but no errors. This is loading
cmn-all.lisp under a freshly compiled clisp image.

-- Fernando