You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
304 lines
11 KiB
304 lines
11 KiB
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)))
|