diff -ur clx-0.7.4.orig/clx.asd clx-0.7.4/clx.asd --- clx-0.7.4.orig/clx.asd 2009-11-28 16:43:30.000000000 +0100 +++ clx-0.7.4/clx.asd 2009-11-29 22:29:11.000000000 +0100 @@ -21,116 +21,80 @@ ;;; or implied warranty. (defpackage :clx-system (:use :cl :asdf)) -(in-package :clx-system) +(in-package :clx-system) (pushnew :clx-ansi-common-lisp *features*) (defclass clx-source-file (cl-source-file) ()) (defclass xrender-source-file (clx-source-file) ()) -;;; CL-SOURCE-FILE, not CLX-SOURCE-FILE, so that we're not accused of -;;; cheating by rebinding *DERIVE-FUNCTION-TYPES* :-) -(defclass example-source-file (cl-source-file) ()) - -(defclass legacy-file (static-file) ()) - -(defsystem CLX - :depends-on (#+sbcl sb-bsd-sockets) - :version "0.7.2" - :serial t - :default-component-class clx-source-file +(defsystem clx + :depends-on (#+sbcl :sb-bsd-sockets) + :version "0.7.4" + :serial t + :default-component-class clx-source-file + :components + ((:file "package") + (:file "depdefs") + (:file "clx") + #-(or openmcl allegro) (:file "dependent") + #+openmcl (:file "dep-openmcl") + #+allegro (:file "dep-allegro") + (:file "macros") + (:file "bufmac") + (:file "buffer") + (:file "display") + (:file "gcontext") + (:file "input") + (:file "requests") + (:file "fonts") + (:file "graphics") + (:file "text") + (:file "attributes") + (:file "translate") + (:file "keysyms") + (:file "manager") + (:file "image") + (:file "resource") + #+allegro + (:file "excldep" :pathname "excldep.lisp") + (:module extensions + :pathname #.(make-pathname :directory '(:relative)) :components - ((:file "package") - (:file "depdefs") - (:file "clx") - #-(or openmcl allegro) (:file "dependent") - #+openmcl (:file "dep-openmcl") - #+allegro (:file "dep-allegro") - (:file "macros") - (:file "bufmac") - (:file "buffer") - (:file "display") - (:file "gcontext") - (:file "input") - (:file "requests") - (:file "fonts") - (:file "graphics") - (:file "text") - (:file "attributes") - (:file "translate") - (:file "keysyms") - (:file "manager") - (:file "image") - (:file "resource") - #+allegro - (:file "excldep" :pathname "excldep.lisp") - (:module extensions - :pathname #.(make-pathname :directory '(:relative)) - :components - ((:file "shape") - (:file "big-requests") - (:file "xvidmode") - (:xrender-source-file "xrender") - (:file "glx") - (:file "gl" :depends-on ("glx")) - (:file "dpms") - (:file "xtest") - (:file "screensaver") - (:file "xinerama"))) - (:module demo - :default-component-class example-source-file - :components - ((:file "bezier") - ;; KLUDGE: this requires "bezier" for proper operation, - ;; but we don't declare that dependency here, because - ;; asdf doesn't load example files anyway. - (:file "beziertest") - (:file "clclock") - (:file "clipboard") - (:file "clx-demos") - (:file "gl-test") - ;; FIXME: compiling this generates 30-odd spurious code - ;; deletion notes. Find out why, and either fix or - ;; workaround the problem. - (:file "mandel") - (:file "menu") - (:file "zoid"))) - (:module test - :default-component-class example-source-file - :components - ((:file "image") - ;; KLUDGE: again, this depends on "zoid" - (:file "trapezoid"))) - (:static-file "NEWS") - (:static-file "CHANGES") - (:static-file "README") - (:static-file "README-R5") - (:legacy-file "exclMakefile") - (:legacy-file "exclREADME") - (:legacy-file "exclcmac" :pathname "exclcmac.lisp") - (:legacy-file "excldepc" :pathname "excldep.c") - (:legacy-file "sockcl" :pathname "sockcl.lisp") - (:legacy-file "socket" :pathname "socket.c") - (:legacy-file "defsystem" :pathname "defsystem.lisp") - (:legacy-file "provide" :pathname "provide.lisp") - (:legacy-file "cmudep" :pathname "cmudep.lisp") - (:module manual - ;; TODO: teach asdf how to process texinfo files - :components ((:static-file "clx.texinfo"))) - (:module debug - :default-component-class legacy-file - :components - ((:file "debug" :pathname "debug.lisp") - (:file "describe" :pathname "describe.lisp") - (:file "event-test" :pathname "event-test.lisp") - (:file "keytrans" :pathname "keytrans.lisp") - (:file "trace" :pathname "trace.lisp") - (:file "util" :pathname "util.lisp"))))) - -(defmethod perform ((o load-op) (f example-source-file)) - ;; do nothing. We want to compile them when CLX is compiled, but - ;; not load them when CLX is loaded. - t) + ((:file "shape") + (:file "big-requests") + (:file "xvidmode") + (:xrender-source-file "xrender") + (:file "glx") + (:file "gl" :depends-on ("glx")) + (:file "dpms") + (:file "xtest") + (:file "screensaver") + (:file "xinerama"))))) + +(defsystem clx-test + :depends-on (:clx) + :serial t + :components + ((:file "image") + (:file "trapezoid"))) + +(defsystem clx-demo + :depends-on (:clx) + :serial t + :components + ((:file "bezier") + (:file "beziertest") + (:file "clclock") + (:file "clipboard") + (:file "clx-demos") + (:file "gl-test") + ;; FIXME: compiling this generates 30-odd spurious code + ;; deletion notes. Find out why, and either fix or + ;; workaround the problem. + (:file "mandel") + (:file "menu") + (:file "zoid"))) #+sbcl (defmethod perform :around ((o compile-op) (f xrender-source-file)) @@ -146,35 +110,35 @@ ;; without STYLE-WARNINGs. Since it currently does, let's enforce ;; it here so that we can catch regressions easily. (let ((on-warnings (operation-on-warnings o)) - (on-failure (operation-on-failure o))) + (on-failure (operation-on-failure o))) (unwind-protect - (progn - (setf (operation-on-warnings o) :error - (operation-on-failure o) :error) - ;; a variety of accessors, such as AREF-CARD32, are not - ;; declared INLINE. Without this (non-ANSI) - ;; static-type-inference behaviour, SBCL emits an extra 100 - ;; optimization notes (roughly one fifth of all of the - ;; notes emitted). Since the internals are unlikely to - ;; change much, and certainly the internals should stay in - ;; sync, enabling this extension is a win. (Note that the - ;; use of this does not imply that applications using CLX - ;; calls that expand into calls to these accessors will be - ;; optimized in the same way). - (let ((sb-ext:*derive-function-types* t) + (progn + (setf (operation-on-warnings o) :error + (operation-on-failure o) :error) + ;; a variety of accessors, such as AREF-CARD32, are not + ;; declared INLINE. Without this (non-ANSI) + ;; static-type-inference behaviour, SBCL emits an extra 100 + ;; optimization notes (roughly one fifth of all of the + ;; notes emitted). Since the internals are unlikely to + ;; change much, and certainly the internals should stay in + ;; sync, enabling this extension is a win. (Note that the + ;; use of this does not imply that applications using CLX + ;; calls that expand into calls to these accessors will be + ;; optimized in the same way). + (let ((sb-ext:*derive-function-types* t) (sadx (find-symbol "STACK-ALLOCATE-DYNAMIC-EXTENT" :sb-c)) (sadx-var (find-symbol "*STACK-ALLOCATE-DYNAMIC-EXTENT*" :sb-ext))) - ;; deeply unportable stuff, this. I will be shot. We - ;; want to enable the dynamic-extent declarations in CLX. - (when (and sadx (sb-c::policy-quality-name-p sadx)) - ;; no way of setting it back short of yet more yukky stuff - (proclaim `(optimize (,sadx 3)))) + ;; deeply unportable stuff, this. I will be shot. We + ;; want to enable the dynamic-extent declarations in CLX. + (when (and sadx (sb-c::policy-quality-name-p sadx)) + ;; no way of setting it back short of yet more yukky stuff + (proclaim `(optimize (,sadx 3)))) (if sadx-var (progv (list sadx-var) (list t) (call-next-method)) (call-next-method)))) (setf (operation-on-warnings o) on-warnings - (operation-on-failure o) on-failure)))) + (operation-on-failure o) on-failure)))) #+sbcl (defmethod perform :around (o (f clx-source-file)) @@ -186,31 +150,31 @@ ;; structured data is sufficiently equal. (handler-bind ((sb-ext:defconstant-uneql - (lambda (c) - ;; KLUDGE: this really means "don't warn me about - ;; efficiency of generic array access, please" - (declare (optimize (sb-ext:inhibit-warnings 3))) - (let ((old (sb-ext:defconstant-uneql-old-value c)) - (new (sb-ext:defconstant-uneql-new-value c))) - (typecase old - (list (when (equal old new) (abort c))) - (string (when (and (typep new 'string) - (string= old new)) - (abort c))) - (simple-vector - (when (and (typep new 'simple-vector) - (= (length old) (length new)) - (every #'eql old new)) - (abort c))) - (array - (when (and (typep new 'array) - (equal (array-dimensions old) - (array-dimensions new)) - (equal (array-element-type old) - (array-element-type new)) - (dotimes (i (array-total-size old) t) - (unless (eql (row-major-aref old i) - (row-major-aref new i)) - (return nil)))) - (abort c)))))))) + (lambda (c) + ;; KLUDGE: this really means "don't warn me about + ;; efficiency of generic array access, please" + (declare (optimize (sb-ext:inhibit-warnings 3))) + (let ((old (sb-ext:defconstant-uneql-old-value c)) + (new (sb-ext:defconstant-uneql-new-value c))) + (typecase old + (list (when (equal old new) (abort c))) + (string (when (and (typep new 'string) + (string= old new)) + (abort c))) + (simple-vector + (when (and (typep new 'simple-vector) + (= (length old) (length new)) + (every #'eql old new)) + (abort c))) + (array + (when (and (typep new 'array) + (equal (array-dimensions old) + (array-dimensions new)) + (equal (array-element-type old) + (array-element-type new)) + (dotimes (i (array-total-size old) t) + (unless (eql (row-major-aref old i) + (row-major-aref new i)) + (return nil)))) + (abort c)))))))) (call-next-method)))