This file is indexed.

/usr/share/common-lisp/source/clx/clx.asd is in cl-clx-sbcl 0.7.4.20160323-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
;;; -*- Lisp -*- mode

;;; Original copyright message from defsystem.lisp:

;;;			 TEXAS INSTRUMENTS INCORPORATED
;;;				  P.O. BOX 2909
;;;			       AUSTIN, TEXAS 78769
;;;
;;; Portions Copyright (C) 1987 Texas Instruments Incorporated.
;;; Portions Copyright (C) 1988, 1989 Franz Inc, Berkeley, Ca.
;;;
;;; Permission is granted to any individual or institution to use,
;;; copy, modify, and distribute this software, provided that this
;;; complete copyright and permission notice is maintained, intact, in
;;; all copies and supporting documentation.
;;;
;;; Texas Instruments Incorporated provides this software "as is"
;;; without express or implied warranty.
;;;
;;; Franz Incorporated provides this software "as is" without express
;;; or implied warranty.

(defpackage :clx-system (:use :cl :asdf))
(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) ())

#+sbcl
(defsystem CLX
    :description "An implementation of the X Window System protocol in Lisp."
    :depends-on (#+sbcl sb-bsd-sockets)
    :version "0.7.2"
    :serial t
    :default-component-class clx-source-file
    :components
    ((:file "package")
     (:file "depdefs")
     (:file "clx")
     #-(or openmcl allegro lispworks) (:file "dependent")
     #+openmcl (:file "dep-openmcl")
     #+allegro (:file "dep-allegro")
     #+lispworks (:file "dep-lispworks")
     (: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)

#+sbcl
(defmethod perform :around ((o compile-op) (f xrender-source-file))
  ;; RENDER would appear to be an inherently slow protocol; further,
  ;; it's not set in stone, and consequently we care less about speed
  ;; than we do about correctness.
  (handler-bind ((sb-ext:compiler-note #'muffle-warning))
    (call-next-method)))

#+sbcl
(defmethod perform :around ((o compile-op) (f clx-source-file))
  ;; 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))))
    (if sadx-var
        (progv (list sadx-var) (list t)
          (call-next-method))
        (call-next-method))))

#+sbcl
(defmethod perform :around (o (f clx-source-file))
  ;; SBCL signals an error if DEFCONSTANT is asked to redefine a
  ;; constant unEQLly.  For CLX's purposes, however, we are defining
  ;; structured constants (lists and arrays) not for EQLity, but for
  ;; the purposes of constant-folding operations such as (MEMBER FOO
  ;; +BAR+), so it is safe to abort the redefinition provided the
  ;; 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))))))))
    (call-next-method)))