[fomus-cvs] CVS fomus

dpsenicka dpsenicka at common-lisp.net
Sun Feb 19 04:20:42 UTC 2006


Update of /project/fomus/cvsroot/fomus
In directory common-lisp:/tmp/cvs-serv3818

Modified Files:
	accidentals.lisp backend_cmn.lisp backend_ly.lisp classes.lisp 
	data.lisp load.lisp main.lisp misc.lisp package.lisp test.lisp 
	util.lisp version.lisp voices.lisp 
Log Message:
bugs/lispworks

--- /project/fomus/cvsroot/fomus/accidentals.lisp	2006/02/11 22:39:40	1.17
+++ /project/fomus/cvsroot/fomus/accidentals.lisp	2006/02/19 04:20:41	1.18
@@ -119,7 +119,7 @@
 ;; depth-first search branching down only top score group (same scores)
 ;; DESTRUCTIVE
 (defstruct (nokeynode (:copier nil) (:predicate nokeynodep))
-  (sc 0.0 :type #-allegro (float 0) #+allegro float)
+  (sc 0.0 :type #-(or allegro lispworks) (float 0) #+(or allegro lispworks) float)
   (ret nil :type list)
   (re 0 :type (integer 0))
   (evs nil :type list)
--- /project/fomus/cvsroot/fomus/backend_cmn.lisp	2006/02/18 22:51:43	1.10
+++ /project/fomus/cvsroot/fomus/backend_cmn.lisp	2006/02/19 04:20:41	1.11
@@ -111,22 +111,29 @@
 	     (format t ";; ERROR: Error ~A CMN file~%" str)
 	     (return-from view-cmn)))
       (ignore-errors (delete-file (change-filename filename :ext (or out-ext +cmn-out-ext+))))
-      (#+cmu unix:unix-chdir #+sbcl sb-posix:chdir #+openmcl ccl:cwd #+allegro excl:chdir
+      (#+cmu unix:unix-chdir #+sbcl sb-posix:chdir #+openmcl ccl:cwd #+allegro excl:chdir #+lispworks hcl:change-directory
 	     (change-filename filename :name nil :ext nil))
       (if (ignore-errors (load filename))
 	  (progn
 	    (unless (probe-file (change-filename filename :ext (or out-ext +cmn-out-ext+))) (er "compiling"))
 	    (when view
-	      (unless #+(or cmu sbcl openmcl) (#+cmu extensions:run-program #+sbcl sb-ext:run-program #+openmcl ccl:run-program
-						     (or view-exe +cmn-view-exe+)
-						     (append (or view-exe-opts +cmn-view-opts+)
-							     (list (change-filename filename :ext (or out-ext +cmn-out-ext+))))
-						     :wait nil)
-		      #+allegro (= (run-allegro-cmd
-				    (apply #'vector (cons (or view-exe +cmn-view-exe+)
-							  (cons (or view-exe +cmn-view-exe+)
+	      (unless #+(or cmu sbcl openmcl) (ignore-errors
+						(#+cmu extensions:run-program #+sbcl sb-ext:run-program #+openmcl ccl:run-program
+						       (or view-exe +cmn-view-exe+)
+						       (append (or view-exe-opts +cmn-view-opts+)
+							       (list (change-filename filename :ext (or out-ext +cmn-out-ext+))))
+						       :wait nil))
+		      #+lispworks (ignore-errors
+				    (system:call-system (format nil "~A~{ ~A~}" (or view-exe +cmn-view-exe+)
 								(append (or view-exe-opts +cmn-view-opts+)
-									(list (change-filename filename :ext (or out-ext +cmn-out-ext+))))))) nil nil) 0)
+									(list (change-filename filename :ext (or out-ext +cmn-out-ext+))))
+								:wait nil)))
+		      #+allegro (eql (run-allegro-cmd
+				      (apply #'vector (cons (or view-exe +cmn-view-exe+)
+							    (cons (or view-exe +cmn-view-exe+)
+								  (append (or view-exe-opts +cmn-view-opts+)
+									  (list (change-filename filename :ext (or out-ext +cmn-out-ext+))))))) nil nil)
+				     0)
 		      (er "viewing"))))
 	(er "compiling")))))
 
--- /project/fomus/cvsroot/fomus/backend_ly.lisp	2006/02/18 22:51:43	1.29
+++ /project/fomus/cvsroot/fomus/backend_ly.lisp	2006/02/19 04:20:41	1.30
@@ -16,15 +16,15 @@
 (eval-when (:load-toplevel :execute)
   (defparameter +lilypond-exe+
     (or #+darwin (find-exe "lilypond.sh")
-	#+mswindows (find-exe "lilypond.exe")
-	#-mswindows (find-exe "lilypond") 
+	#+(or mswindows win32) (find-exe "lilypond.exe")
+	#-(or mswindows win32) (find-exe "lilypond") 
 	#+darwin "lilypond.sh"
-	#+mswindows "lilypond.exe"
-	#-mswindows "lilypond"))
-  (defparameter +lilypond-view-exe+ #-mswindows +ghostview-exe+ #+mswindows +acroread-exe+))
+	#+(or mswindows win32) "lilypond.exe"
+	#-(or mswindows win32) "lilypond"))
+  (defparameter +lilypond-view-exe+ #-(or mswindows win32) +ghostview-exe+ #+(or mswindows win32) +acroread-exe+))
 
-(defparameter +lilypond-opts+ #-(or darwin mswindows) '("--ps") #+(or darwin mswindows) '("--pdf"))
-(defparameter +lilypond-out-ext+ #-(or darwin mswindows) "ps" #+(or darwin mswindows) "pdf")
+(defparameter +lilypond-opts+ #-(or darwin mswindows win32) '("--ps") #+(or darwin mswindows win32) '("--pdf"))
+(defparameter +lilypond-out-ext+ #-(or darwin mswindows win32) "ps" #+(or darwin mswindows win32) "pdf")
 (defparameter +lilypond-view-opts+ #-darwin nil #+darwin '("/Applications/Preview.app"))
 
 (defun view-lilypond (filename options view)
@@ -34,15 +34,21 @@
 	     (format t ";; ERROR: Error ~A lilypond file~%" str)
 	     (return-from view-lilypond)))
       (ignore-errors (delete-file (change-filename filename :ext (or out-ext +lilypond-out-ext+))))
-      (#+cmu unix:unix-chdir #+sbcl sb-posix:chdir #+openmcl ccl:cwd #+allegro excl:chdir
+      (#+cmu unix:unix-chdir #+sbcl sb-posix:chdir #+openmcl ccl:cwd #+allegro excl:chdir #+lispworks hcl:change-directory
 	     (change-filename filename :name nil :ext nil))
-      (if #+(or cmu sbcl openmcl) (#+cmu extensions:run-program #+sbcl sb-ext:run-program #+openmcl ccl:run-program
-				    (or exe +lilypond-exe+)
-				    (append (or exe-opts +lilypond-opts+) (list filename))
-				    :wait t)
-	  #+allegro (= (run-allegro-cmd (apply #'vector (cons (or exe +lilypond-exe+)
-							      (cons (or exe +lilypond-exe+)
-								    (append (or exe-opts +lilypond-opts+) (list filename)))))) 0)
+      (if #+(or cmu sbcl openmcl) (ignore-errors
+				    (#+cmu extensions:run-program #+sbcl sb-ext:run-program #+openmcl ccl:run-program
+					   (or exe +lilypond-exe+)
+					   (append (or exe-opts +lilypond-opts+) (list filename))
+					   :wait t))
+	  #+lispworks (ignore-errors
+			(system:call-system (format nil "~A~{ ~A~}" 
+						    (or exe +lilypond-exe+)
+						    (append (or exe-opts +lilypond-opts+) (list filename))
+						    :wait t)))
+	  #+allegro (eql (run-allegro-cmd (apply #'vector (cons (or exe +lilypond-exe+)
+								(cons (or exe +lilypond-exe+)
+								      (append (or exe-opts +lilypond-opts+) (list filename)))))) 0)
 	  (progn
 	    (unless (probe-file (change-filename filename :ext (or out-ext +lilypond-out-ext+))) (er "compiling"))
 	    (ignore-errors (delete-file (change-filename filename :ext "log")))
@@ -51,16 +57,24 @@
 	    (unless (string= (or out-ext +lilypond-out-ext+) "ps") (ignore-errors (delete-file (change-filename filename :ext "ps")))) 
 	    (unless (string= (or out-ext +lilypond-out-ext+) "pdf") (ignore-errors (delete-file (change-filename filename :ext "pdf"))))
 	    (when view
-	      (unless #+(or cmu sbcl openmcl) (#+cmu extensions:run-program #+sbcl sb-ext:run-program #+openmcl ccl:run-program
-						     (or view-exe +lilypond-view-exe+)
-						     (append (or view-exe-opts +lilypond-view-opts+)
-							     (list (change-filename filename :ext (or out-ext +lilypond-out-ext+))))
-						     :wait nil)
-		      #+allegro (= (run-allegro-cmd
-				    (apply #'vector (cons (or view-exe +lilypond-view-exe+)
-							  (cons (or view-exe +lilypond-view-exe+)
+	      (unless #+(or cmu sbcl openmcl) (ignore-errors
+						(#+cmu extensions:run-program #+sbcl sb-ext:run-program #+openmcl ccl:run-program
+						       (or view-exe +lilypond-view-exe+)
+						       (append (or view-exe-opts +lilypond-view-opts+)
+							       (list (change-filename filename :ext (or out-ext +lilypond-out-ext+))))
+						       :wait nil))
+		      #+lispworks (ignore-errors
+				    (system:call-system (format nil "~A~{ ~A~}" 
+								(or view-exe +lilypond-view-exe+)
 								(append (or view-exe-opts +lilypond-view-opts+)
-									(list (change-filename filename :ext (or out-ext +lilypond-out-ext+))))))) nil nil) 0)
+									(list (change-filename filename :ext (or out-ext +lilypond-out-ext+))))
+								:wait nil)))
+		      #+allegro (eql (run-allegro-cmd
+				      (apply #'vector (cons (or view-exe +lilypond-view-exe+)
+							    (cons (or view-exe +lilypond-view-exe+)
+								  (append (or view-exe-opts +lilypond-view-opts+)
+									  (list (change-filename filename :ext (or out-ext +lilypond-out-ext+))))))) nil nil)
+				     0)
 		      (er "viewing"))))
 	  (er "compiling")))))
 
@@ -69,12 +83,17 @@
   (if (truep *lilypond-version*)
       (setf *lilypond-version*
 	    (destructuring-bind (&key exe &allow-other-keys) options
-	      (let ((os #+(or cmu sbcl openmcl) (make-string-output-stream)
-			#+allegro (ignore-errors (nth-value 1 (run-allegro-cmd (vector (or exe +lilypond-exe+) (or exe +lilypond-exe+) "-v"))))))
+	      (let ((os #+(or cmu sbcl openmcl lispworks) (make-string-output-stream)
+			#+allegro (nth-value 1 (run-allegro-cmd (vector (or exe +lilypond-exe+) (or exe +lilypond-exe+) "-v")))))
 		#+(or cmu sbcl openmcl) (ignore-errors (#+cmu extensions:run-program #+sbcl sb-ext:run-program #+openmcl ccl:run-program
 							      (or exe +lilypond-exe+)
 							      (list "-v") :wait t :output os))
-		(let* ((out #+(or cmu sbcl openmcl) (get-output-stream-string os) #+allegro (read-line os))
+		#+lispworks (ignore-errors
+			      (system:call-system (format nil "~A~{ ~A~}"
+							  (or exe +lilypond-exe+)
+							  (list "-v")
+							  :wait t)))
+		(let* ((out #+(or cmu sbcl openmcl lispworks) (get-output-stream-string os) #+allegro (read-line os))
 		       (p (search "LilyPond " out)))
 		  (if p (multiple-value-bind (n1 np) (parse-integer out :start (+ p 9) :junk-allowed t)
 			  (+ (* n1 100) (parse-integer out :start (1+ np) :junk-allowed t)))
@@ -228,7 +247,7 @@
 							   (list (make-restex :inv t :off (meas-off m) :dur (- (meas-endoff m) (meas-off m)) :marks '(:measrest)))))
 			  while e
 			  do (let ((fm (getmark e :measrest))
-				   (trf (and (>= (nth-value 1 (event-writtendur* e ts)) 2) (< (lilypond-version options) 205))))
+				   (trf (and (>= (nth-value 1 (event-writtendur* e ts)) 2) (< (lilypond-version options) 207))))
 			       (when (getmark e '(:starttext- 2)) (setf twrn t))
 			       (format f "~A "
 				       (conc-strings
--- /project/fomus/cvsroot/fomus/classes.lisp	2006/02/18 22:51:43	1.17
+++ /project/fomus/cvsroot/fomus/classes.lisp	2006/02/19 04:20:41	1.18
@@ -48,7 +48,11 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (excl:without-package-locks
     (defclass rest (dur-base) ())))
-#-(or sbcl allegro)
+#+lispworks
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (let ((lispworks:*handle-warn-on-redefinition* nil))
+    (defclass rest (dur-base) ())))
+#-(or sbcl allegro lispworks)
 (defclass rest (dur-base) ()) ; only w/ xml in special cases--must not overlap a note-event!!!
 
 (defclass part (fomusobj-base)
@@ -74,7 +78,10 @@
 #+allegro (eval-when (:compile-toplevel :load-toplevel :execute)
 	    (excl:without-package-locks
 	      (defprint rest id partid voice off dur marks)))
-#-allegro (defprint rest id partid voice off dur marks)
+#+lispworks (eval-when (:compile-toplevel :load-toplevel :execute)
+	      (let ((lispworks:*handle-warn-on-redefinition* nil))
+		(defprint rest id partid voice off dur marks)))
+#-(or allegro lispworks) (defprint rest id partid voice off dur marks)
 (defprint part id partid name abbrev instr events opts)
 (defprint meas id off endoff timesig div events props)
 
@@ -374,6 +381,38 @@
   (declare (type meas me) (type timesig-repl timesig) (type (rational 0) off) (type (rational 0) endoff) (type list events props div))
   (make-meas :id id :timesig timesig :off off :endoff endoff :events events :props props :div div))
 
+;; MAKE-INSTR
+
+(defun make-instrex* (instr part)
+  (declare (type instr instr))
+  (copy-instr instr
+	      :8uplegls (if (consp (instr-8uplegls instr)) (cons (first (instr-8uplegls instr)) (second (instr-8uplegls instr))) (instr-8uplegls instr))
+	      :8dnlegls (if (consp (instr-8dnlegls instr)) (cons (first (instr-8dnlegls instr)) (second (instr-8dnlegls instr))) (instr-8dnlegls instr))
+	      :percs (loop for e in (instr-percs instr) collect
+			   (flet ((er (s) (error "Invalid percussion instrument ~S in part ~S" s (part-name part))))
+			     (flet ((gi (s)
+				      (declare (type (or symbol (integer 0 127)) s))
+				      (if (symbolp s)
+					  (or (find s *percussion* :key #'perc-sym)
+					      (find s +percussion+ :key #'perc-sym)
+					      (er s))
+					  (or (find s *percussion* :test (lambda (k i)
+									   (declare (type (integer 0 127) k) (type perc i))
+									   (find k (force-list (perc-midinote-im i)))))
+					      (find s +percussion+ :test (lambda (k i)
+									   (declare (type (integer 0 127) k) (type perc i))
+									   (find k (force-list (perc-midinote-im i)))))
+					      (er s)))))
+			       (let ((z (typecase e
+					  (perc (copy-perc e))
+					  ((or symbol number) (copy-perc (gi e))) 
+					  (list (let ((z (apply #'copy-perc (gi (first e)) (rest e))))
+						  (check-type* z +perc-type+)
+						  z))
+					  (otherwise (er e)))))
+				 (when (perc-note z) (setf (perc-note z) (note-to-num (perc-note z))))
+				 z))))))
+  
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; INPUT TYPE CHECKS
 
--- /project/fomus/cvsroot/fomus/data.lisp	2006/02/18 22:51:43	1.33
+++ /project/fomus/cvsroot/fomus/data.lisp	2006/02/19 04:20:41	1.34
@@ -12,7 +12,7 @@
 ;; GLOBAL FOR BACKENDS
 
 #+(or linux darwin unix) (defparameter +tmp-path+ "/tmp/")
-#+mswindows (defparameter +tmp-path+ "\\")
+#+(or mswindows win32) (defparameter +tmp-path+ "/")
 
 (declaim (type boolean *acc-throughout-meas*))
 (defparameter *acc-throughout-meas* t)
@@ -453,36 +453,6 @@
 		    finally (return (nconc (mapcar #'car (sort i #'> :key #'cdr)) p
 					   (list (cons :choirgroup v)) (list (cons :choirgroup c)) k))))))
 
-(defun make-instrex* (instr part)
-  (declare (type instr instr))
-  (copy-instr instr
-	      :8uplegls (if (consp (instr-8uplegls instr)) (cons (first (instr-8uplegls instr)) (second (instr-8uplegls instr))) (instr-8uplegls instr))
-	      :8dnlegls (if (consp (instr-8dnlegls instr)) (cons (first (instr-8dnlegls instr)) (second (instr-8dnlegls instr))) (instr-8dnlegls instr))
-	      :percs (loop for e in (instr-percs instr) collect
-			   (flet ((er (s) (error "Invalid percussion instrument ~S in part ~S" s (part-name part))))
-			     (flet ((gi (s)
-				      (declare (type (or symbol (integer 0 127)) s))
-				      (if (symbolp s)
-					  (or (find s *percussion* :key #'perc-sym)
-					      (find s +percussion+ :key #'perc-sym)
-					      (er s))
-					  (or (find s *percussion* :test (lambda (k i)
-									   (declare (type (integer 0 127) k) (type perc i))
-									   (find k (force-list (perc-midinote-im i)))))
-					      (find s +percussion+ :test (lambda (k i)
-									   (declare (type (integer 0 127) k) (type perc i))
-									   (find k (force-list (perc-midinote-im i)))))
-					      (er s)))))
-			       (let ((z (typecase e
-					  (perc (copy-perc e))
-					  ((or symbol number) (copy-perc (gi e))) 
-					  (list (let ((z (apply #'copy-perc (gi (first e)) (rest e))))
-						  (check-type* z +perc-type+)
-						  z))
-					  (otherwise (er e)))))
-				 (when (perc-note z) (setf (perc-note z) (note-to-num (perc-note z))))
-				 z))))))
-  
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; DEFAULT DIVISIONS
 
--- /project/fomus/cvsroot/fomus/load.lisp	2005/11/11 22:03:16	1.8
+++ /project/fomus/cvsroot/fomus/load.lisp	2006/02/19 04:20:41	1.9
@@ -1,16 +1,21 @@
 ;; -*-lisp-*-
 ;; Load file for FOMUS
 
-(loop with fl = '("package" "version" "misc" "deps" "data" "classes" "util" "splitrules" "accidentals" "beams" "marks"
-		  "other" "ottavas" "parts" "postproc" "split" "staves" "voices" "quantize" "backend_cmn" "backend_ly"
-		  "backend_xml" "backend_mid" "backends" "main" "interface" "final")
+(loop with fl = '("package" "version" "misc" "deps" "data" "classes" "util"
+		  "splitrules"
+		  ("accidentals" "beams" "marks" "other" "ottavas" "parts" "postproc" "split" "staves" "voices" "quantize")
+		  ("backend_cmn" "backend_ly" "backend_xml" "backend_mid")
+		  "backends" "main" "interface" "final")
       and nw
       for na in fl
-      for cl = (merge-pathnames na *load-pathname*)
-      for cn = (compile-file-pathname cl) do
-      (when (or nw
-		(not (probe-file cn))
-		(>= (file-write-date cl) (file-write-date cn)))
-	(compile-file cl)
-	(setf nw t))
-      (load cn))
\ No newline at end of file
+      for cl = (if (listp na) (mapcar (lambda (x) (merge-pathnames x *load-pathname*)) na) (list (merge-pathnames na *load-pathname*)))
+      for cn = (mapcar (lambda (x) (compile-file-pathname x)) cl)
+      do (loop with nw0
+	       for cn0 in cn
+	       and cl0 in cl
+	       when (or nw
+			(not (probe-file cn0))
+			(>= (file-write-date cl0) (file-write-date cn0)))
+	       do (compile-file cl0) (setf nw0 t)
+	       finally (setf nw nw0))
+      (map nil (lambda (x) (load x)) cn))
\ No newline at end of file
--- /project/fomus/cvsroot/fomus/main.lisp	2006/02/18 22:51:43	1.22
+++ /project/fomus/cvsroot/fomus/main.lisp	2006/02/19 04:20:41	1.23
@@ -202,7 +202,8 @@
 					    #+cmu (ext:default-directory)
 					    #+sbcl (sb-unix:posix-getcwd)
 					    #+openmcl (ccl:mac-default-directory)
-					    #+allegro (excl:current-directory)))
+					    #+allegro (excl:current-directory)
+					    #+lispworks (hcl:get-working-directory)))
 			  r (rest xx) (or process view) play view)))))
   t)
 
--- /project/fomus/cvsroot/fomus/misc.lisp	2006/02/03 07:17:18	1.17
+++ /project/fomus/cvsroot/fomus/misc.lisp	2006/02/19 04:20:41	1.18
@@ -14,7 +14,11 @@
 (declaim (inline change-filename))
 (defun change-filename (filename &key (dir (pathname-directory filename)) (name (pathname-name filename)) (ext (pathname-type filename)))
   (declare (type (or pathname string null) filename name ext) (type (or pathname string list) dir))
-  (namestring (make-pathname :device (pathname-device filename) :directory dir :name name :type ext)))
+  (namestring (make-pathname :device (pathname-device filename) :directory #-(and (or mswindows win32) lispworks)
+			     dir #+(and (or mswindows win32) lispworks) (if (or (stringp dir) (pathnamep dir))
+                                                                            (pathname-directory dir)
+									    dir)
+			     :name name :type ext)))
 
 (declaim (inline conc-strings conc-stringlist))
 (defun conc-strings (&rest strings)
@@ -72,13 +76,14 @@
 
 #+allegro
 (defun run-allegro-cmd (cmd &optional (wait t) (hide t))
-  (multiple-value-bind (ostr istr p) (excl:run-shell-command
-				      #-mswindows cmd
-				      #+mswindows (if (typep cmd 'string) cmd
-						      (conc-stringlist (loop for e across cmd and i = nil then t when i collect e and collect " ")))
-				      :input :stream :output :stream :error-output :stream :wait nil :show-window (if hide :hide :normal))
-    (declare (ignore istr))
-    (values (if wait (sys:os-wait nil p) 0) ostr)))
+  (ignore-errors
+    (multiple-value-bind (ostr istr p) (excl:run-shell-command
+					#-(or mswindows win32) cmd
+					#+(or mswindows win32) (if (typep cmd 'string) cmd
+								   (conc-stringlist (loop for e across cmd and i = nil then t when i collect e and collect " ")))
+					:input :stream :output :stream :error-output :stream :wait nil :show-window (if hide :hide :normal))
+      (declare (ignore istr))
+      (values (if wait (sys:os-wait nil p) 0) ostr))))
 
 (defun find-exe (filename)
   (namestring*
@@ -87,13 +92,13 @@
        #+darwin (find-if (lambda (x) (probe-file x)) (mapcar (lambda (x) (change-filename filename :dir (namestring x))) (directory "/Applications/*/*" #+openmcl :directories #+openmcl t)))
        #+darwin (find-if (lambda (x) (probe-file x)) (mapcar (lambda (x) (change-filename filename :dir (namestring x))) (directory "/Applications/*/*/*" #+openmcl :directories #+openmcl t)))
        #+darwin (probe-file (change-filename filename :dir "/sw/bin"))
-       #+mswindows (find-if (lambda (x) (probe-file x)) (mapcar (lambda (x) (change-filename filename :dir (namestring x))) (directory "\\Program Files\\*" #+openmcl :directories #+openmcl t)))
-       #+mswindows (find-if (lambda (x) (probe-file x)) (mapcar (lambda (x) (change-filename filename :dir (namestring x))) (directory "\\Program Files\\*\\*" #+openmcl :directories #+openmcl t)))
-       #+mswindows (find-if (lambda (x) (probe-file x)) (mapcar (lambda (x) (change-filename filename :dir (namestring x))) (directory "\\Program Files\\*\\*\\*" #+openmcl :directories #+openmcl t)))
-       #+mswindows (probe-file (change-filename filename :dir "\\cygwin\\usr\\local\\bin"))
-       #+mswindows (probe-file (change-filename filename :dir "\\cygwin\\usr\\bin"))
-       #+mswindows (probe-file (change-filename filename :dir "\\cygwin\\bin"))
-       #+mswindows (probe-file (change-filename filename :dir "\\cygwin\\usr\\X11R6\\bin"))
+       #+(or mswindows win32) (find-if (lambda (x) (probe-file x)) (mapcar (lambda (x) (change-filename filename :dir (namestring x))) (directory "/Program Files/*" #+openmcl :directories #+openmcl t)))
+       #+(or mswindows win32) (find-if (lambda (x) (probe-file x)) (mapcar (lambda (x) (change-filename filename :dir (namestring x))) (directory "/Program Files/*/*" #+openmcl :directories #+openmcl t)))
+       #+(or mswindows win32) (find-if (lambda (x) (probe-file x)) (mapcar (lambda (x) (change-filename filename :dir (namestring x))) (directory "/Program Files/*/*/*" #+openmcl :directories #+openmcl t)))
+       #+(or mswindows win32) (probe-file (change-filename filename :dir "/cygwin/usr/local/bin"))
+       #+(or mswindows win32) (probe-file (change-filename filename :dir "/cygwin/usr/bin"))
+       #+(or mswindows win32) (probe-file (change-filename filename :dir "/cygwin/bin"))
+       #+(or mswindows win32) (probe-file (change-filename filename :dir "/cygwin/usr/X11R6/bin"))
        #+(or linux darwin unix) (probe-file (change-filename filename :dir "/usr/local/bin"))
        #+(or linux darwin unix) (probe-file (change-filename filename :dir "/usr/bin"))
        #+(or linux darwin unix) (probe-file (change-filename filename :dir "/bin"))
--- /project/fomus/cvsroot/fomus/package.lisp	2005/11/30 23:51:37	1.13
+++ /project/fomus/cvsroot/fomus/package.lisp	2006/02/19 04:20:41	1.14
@@ -46,6 +46,9 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; GLOBAL
 
+;; :ALLEGRO-V7.0
+;; :LISPWORKS4
+
 (defmacro compile-settings ()
   '(eval-when (:compile-toplevel)
     #+debug (declaim (optimize (safety 3) (debug 3)))
--- /project/fomus/cvsroot/fomus/test.lisp	2006/02/18 22:51:43	1.25
+++ /project/fomus/cvsroot/fomus/test.lisp	2006/02/19 04:20:41	1.26
@@ -267,7 +267,7 @@
 	 collect (make-note :off off :dur dur :note (+ 60 (random 25)))))))
 
 (fomus
- :backend '((:data) :musicxml (:lilypond :view t) #|(:cmn :view t)|# #|(:midi :tempo 60 :delay 1)|#)
+ :backend '((:data) (:lilypond :view t) #|(:cmn :view t)|# #|(:midi :tempo 60 :delay 1)|#)
  :ensemble-type :orchestra
  :parts
  (list
--- /project/fomus/cvsroot/fomus/util.lisp	2006/02/18 22:51:43	1.23
+++ /project/fomus/cvsroot/fomus/util.lisp	2006/02/19 04:20:41	1.24
@@ -36,11 +36,11 @@
   (defparameter +ghostview-exe+
     #+darwin (find-exe "open")
     #+(and (or linux unix) (not darwin)) (or (find-exe "ggv") (find-exe "kgv") (find-exe "gv") (find-exe "ghostview") "gv")
-    #+mswindows (or (find-exe "gsview32.exe") (find-exe "gv.exe") "gsview.exe"))
+    #+(or mswindows win32) (or (find-exe "gsview32.exe") (find-exe "gv.exe") "gsview.exe"))
   (defparameter +acroread-exe+
     #+darwin (find-exe "open")
     #+(and (or linux unix) (not darwin)) (or (find-exe "acroread") (find-exe "gpdf") "acroread")
-    #+mswindows (or (find-exe "AcroRd32.exe") "AcroRd32.exe")))
+    #+(or mswindows win32) (or (find-exe "AcroRd32.exe") "AcroRd32.exe")))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; PROGRESS DOTS, IMMEDIATE OUTPUT
--- /project/fomus/cvsroot/fomus/version.lisp	2006/02/18 22:51:43	1.33
+++ /project/fomus/cvsroot/fomus/version.lisp	2006/02/19 04:20:41	1.34
@@ -12,7 +12,7 @@
 (declaim (type string +title+)
 	 (type cons +version+ +banner+))
 (defparameter +title+ "FOMUS")
-(defparameter +version+ '(0 1 38))
+(defparameter +version+ '(0 1 39))
 (defparameter +banner+
   `("Lisp music notation formatter"
     "Copyright (c) 2005, 2006 David Psenicka, All Rights Reserved"
--- /project/fomus/cvsroot/fomus/voices.lisp	2006/01/19 00:02:35	1.11
+++ /project/fomus/cvsroot/fomus/voices.lisp	2006/02/19 04:20:41	1.12
@@ -90,7 +90,7 @@
 (defparameter *voice-engine-heap* 50)
 
 (defstruct (voicenode (:copier nil) (:predicate voicenodep))
-  (sc 0.0 :type #-allegro (float 0) #+allegro float)
+  (sc 0.0 :type #-(or allegro lispworks) (float 0) #+(or allegro lispworks) float)
   (ret nil :type list)
   (evs nil :type list)
   (evc nil :type list)




More information about the Fomus-cvs mailing list