/[cmucl]/src/clx/clx.asd
ViewVC logotype

Contents of /src/clx/clx.asd

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.2.1 - (show annotations)
Wed Jun 17 15:46:26 2009 UTC (4 years, 10 months ago) by rtoy
Branch: portable-clx-branch
CVS Tags: portable-clx-import-2009-06-16
Changes since 1.1: +216 -0 lines
Import portable clx version from Christophe Rhodes darcs repository as
of 2009-06-16.

This is an exact copy of the code.  It is intended updates of
portable-clx go on the portable-clx-branch and should be merged to the
main branch as needed.  This should make it easier to do any
CMUCL-specific changes that aren't in portable-clx.

I chose not to import the files in the clx/manual directory.
Everything else is imported.  (Should the manual be imported too?)
1 ;;; -*- Lisp -*- mode
2
3 ;;; Original copyright message from defsystem.lisp:
4
5 ;;; TEXAS INSTRUMENTS INCORPORATED
6 ;;; P.O. BOX 2909
7 ;;; AUSTIN, TEXAS 78769
8 ;;;
9 ;;; Portions Copyright (C) 1987 Texas Instruments Incorporated.
10 ;;; Portions Copyright (C) 1988, 1989 Franz Inc, Berkeley, Ca.
11 ;;;
12 ;;; Permission is granted to any individual or institution to use,
13 ;;; copy, modify, and distribute this software, provided that this
14 ;;; complete copyright and permission notice is maintained, intact, in
15 ;;; all copies and supporting documentation.
16 ;;;
17 ;;; Texas Instruments Incorporated provides this software "as is"
18 ;;; without express or implied warranty.
19 ;;;
20 ;;; Franz Incorporated provides this software "as is" without express
21 ;;; or implied warranty.
22
23 (defpackage :clx-system (:use :cl :asdf))
24 (in-package :clx-system)
25
26 (pushnew :clx-ansi-common-lisp *features*)
27
28 (defclass clx-source-file (cl-source-file) ())
29 (defclass xrender-source-file (clx-source-file) ())
30
31 ;;; CL-SOURCE-FILE, not CLX-SOURCE-FILE, so that we're not accused of
32 ;;; cheating by rebinding *DERIVE-FUNCTION-TYPES* :-)
33 (defclass example-source-file (cl-source-file) ())
34
35 (defclass legacy-file (static-file) ())
36
37 (defsystem CLX
38 :depends-on (#+sbcl sb-bsd-sockets)
39 :version "0.7.2"
40 :serial t
41 :default-component-class clx-source-file
42 :components
43 ((:file "package")
44 (:file "depdefs")
45 (:file "clx")
46 #-(or openmcl allegro) (:file "dependent")
47 #+openmcl (:file "dep-openmcl")
48 #+allegro (:file "dep-allegro")
49 (:file "macros")
50 (:file "bufmac")
51 (:file "buffer")
52 (:file "display")
53 (:file "gcontext")
54 (:file "input")
55 (:file "requests")
56 (:file "fonts")
57 (:file "graphics")
58 (:file "text")
59 (:file "attributes")
60 (:file "translate")
61 (:file "keysyms")
62 (:file "manager")
63 (:file "image")
64 (:file "resource")
65 #+allegro
66 (:file "excldep" :pathname "excldep.lisp")
67 (:module extensions
68 :pathname #.(make-pathname :directory '(:relative))
69 :components
70 ((:file "shape")
71 (:file "big-requests")
72 (:file "xvidmode")
73 (:xrender-source-file "xrender")
74 (:file "glx")
75 (:file "gl" :depends-on ("glx"))
76 (:file "dpms")
77 (:file "xtest")
78 (:file "screensaver")
79 (:file "xinerama")))
80 (:module demo
81 :default-component-class example-source-file
82 :components
83 ((:file "bezier")
84 ;; KLUDGE: this requires "bezier" for proper operation,
85 ;; but we don't declare that dependency here, because
86 ;; asdf doesn't load example files anyway.
87 (:file "beziertest")
88 (:file "clclock")
89 (:file "clipboard")
90 (:file "clx-demos")
91 (:file "gl-test")
92 ;; FIXME: compiling this generates 30-odd spurious code
93 ;; deletion notes. Find out why, and either fix or
94 ;; workaround the problem.
95 (:file "mandel")
96 (:file "menu")
97 (:file "zoid")))
98 (:module test
99 :default-component-class example-source-file
100 :components
101 ((:file "image")
102 ;; KLUDGE: again, this depends on "zoid"
103 (:file "trapezoid")))
104 (:static-file "NEWS")
105 (:static-file "CHANGES")
106 (:static-file "README")
107 (:static-file "README-R5")
108 (:legacy-file "exclMakefile")
109 (:legacy-file "exclREADME")
110 (:legacy-file "exclcmac" :pathname "exclcmac.lisp")
111 (:legacy-file "excldepc" :pathname "excldep.c")
112 (:legacy-file "sockcl" :pathname "sockcl.lisp")
113 (:legacy-file "socket" :pathname "socket.c")
114 (:legacy-file "defsystem" :pathname "defsystem.lisp")
115 (:legacy-file "provide" :pathname "provide.lisp")
116 (:legacy-file "cmudep" :pathname "cmudep.lisp")
117 (:module manual
118 ;; TODO: teach asdf how to process texinfo files
119 :components ((:static-file "clx.texinfo")))
120 (:module debug
121 :default-component-class legacy-file
122 :components
123 ((:file "debug" :pathname "debug.lisp")
124 (:file "describe" :pathname "describe.lisp")
125 (:file "event-test" :pathname "event-test.lisp")
126 (:file "keytrans" :pathname "keytrans.lisp")
127 (:file "trace" :pathname "trace.lisp")
128 (:file "util" :pathname "util.lisp")))))
129
130 (defmethod perform ((o load-op) (f example-source-file))
131 ;; do nothing. We want to compile them when CLX is compiled, but
132 ;; not load them when CLX is loaded.
133 t)
134
135 #+sbcl
136 (defmethod perform :around ((o compile-op) (f xrender-source-file))
137 ;; RENDER would appear to be an inherently slow protocol; further,
138 ;; it's not set in stone, and consequently we care less about speed
139 ;; than we do about correctness.
140 (handler-bind ((sb-ext:compiler-note #'muffle-warning))
141 (call-next-method)))
142
143 #+sbcl
144 (defmethod perform :around ((o compile-op) (f clx-source-file))
145 ;; our CLX library should compile without WARNINGs, and ideally
146 ;; without STYLE-WARNINGs. Since it currently does, let's enforce
147 ;; it here so that we can catch regressions easily.
148 (let ((on-warnings (operation-on-warnings o))
149 (on-failure (operation-on-failure o)))
150 (unwind-protect
151 (progn
152 (setf (operation-on-warnings o) :error
153 (operation-on-failure o) :error)
154 ;; a variety of accessors, such as AREF-CARD32, are not
155 ;; declared INLINE. Without this (non-ANSI)
156 ;; static-type-inference behaviour, SBCL emits an extra 100
157 ;; optimization notes (roughly one fifth of all of the
158 ;; notes emitted). Since the internals are unlikely to
159 ;; change much, and certainly the internals should stay in
160 ;; sync, enabling this extension is a win. (Note that the
161 ;; use of this does not imply that applications using CLX
162 ;; calls that expand into calls to these accessors will be
163 ;; optimized in the same way).
164 (let ((sb-ext:*derive-function-types* t)
165 (sadx (find-symbol "STACK-ALLOCATE-DYNAMIC-EXTENT" :sb-c))
166 (sadx-var (find-symbol "*STACK-ALLOCATE-DYNAMIC-EXTENT*" :sb-ext)))
167 ;; deeply unportable stuff, this. I will be shot. We
168 ;; want to enable the dynamic-extent declarations in CLX.
169 (when (and sadx (sb-c::policy-quality-name-p sadx))
170 ;; no way of setting it back short of yet more yukky stuff
171 (proclaim `(optimize (,sadx 3))))
172 (if sadx-var
173 (progv (list sadx-var) (list t)
174 (call-next-method))
175 (call-next-method))))
176 (setf (operation-on-warnings o) on-warnings
177 (operation-on-failure o) on-failure))))
178
179 #+sbcl
180 (defmethod perform :around (o (f clx-source-file))
181 ;; SBCL signals an error if DEFCONSTANT is asked to redefine a
182 ;; constant unEQLly. For CLX's purposes, however, we are defining
183 ;; structured constants (lists and arrays) not for EQLity, but for
184 ;; the purposes of constant-folding operations such as (MEMBER FOO
185 ;; +BAR+), so it is safe to abort the redefinition provided the
186 ;; structured data is sufficiently equal.
187 (handler-bind
188 ((sb-ext:defconstant-uneql
189 (lambda (c)
190 ;; KLUDGE: this really means "don't warn me about
191 ;; efficiency of generic array access, please"
192 (declare (optimize (sb-ext:inhibit-warnings 3)))
193 (let ((old (sb-ext:defconstant-uneql-old-value c))
194 (new (sb-ext:defconstant-uneql-new-value c)))
195 (typecase old
196 (list (when (equal old new) (abort c)))
197 (string (when (and (typep new 'string)
198 (string= old new))
199 (abort c)))
200 (simple-vector
201 (when (and (typep new 'simple-vector)
202 (= (length old) (length new))
203 (every #'eql old new))
204 (abort c)))
205 (array
206 (when (and (typep new 'array)
207 (equal (array-dimensions old)
208 (array-dimensions new))
209 (equal (array-element-type old)
210 (array-element-type new))
211 (dotimes (i (array-total-size old) t)
212 (unless (eql (row-major-aref old i)
213 (row-major-aref new i))
214 (return nil))))
215 (abort c))))))))
216 (call-next-method)))

  ViewVC Help
Powered by ViewVC 1.1.5