/usr/share/common-lisp/source/contextl/cx-class-in-layer.lisp is in cl-contextl 1:0.61-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 | (in-package :contextl)
(defgeneric class-layer (class)
(:method ((class class)) 't))
(defclass standard-class-in-layer (standard-class)
((layer :initarg :in-layer
:initarg :in
:initform 't
:reader class-layer)))
(defmethod validate-superclass
((class standard-class-in-layer)
(superclass standard-class))
t)
(defgeneric slot-definition-layer (slot)
(:method ((slot direct-slot-definition)) 't))
(defclass standard-direct-slot-definition-in-layer (standard-direct-slot-definition)
((layer :initarg :in-layer
:initarg :in
:initform 't
:reader slot-definition-layer)))
(defmethod direct-slot-definition-class
((class standard-class-in-layer) &key &allow-other-keys)
(find-class 'standard-direct-slot-definition-in-layer))
(defgeneric slot-definition-layers (slot)
(:method ((slot effective-slot-definition)) '(t)))
(defclass standard-effective-slot-definition-in-layers (standard-effective-slot-definition)
((layers :initform '(t)
:reader slot-definition-layers)))
(defmethod effective-slot-definition-class
((class standard-class-in-layer) &key &allow-other-keys)
(find-class 'standard-effective-slot-definition-in-layers))
(defmethod compute-effective-slot-definition
((class standard-class-in-layer) name direct-slot-definitions)
(declare (ignore name))
(let ((slot (call-next-method)))
(setf (slot-value slot 'layers)
(loop for direct-slot in direct-slot-definitions
for layer = (slot-definition-layer direct-slot)
for layer-name = (or (layer-name layer) layer)
for layers = (list layer-name) then (adjoin layer-name layers :test #'eq)
finally (return layers)))
slot))
(defmethod initialize-instance :around
((class standard-class-in-layer) &rest initargs
&key (direct-slots ()) (in-layer 't))
(declare (dynamic-extent initargs))
(apply #'call-next-method class
:direct-slots
(loop for direct-slot in direct-slots
if (get-properties direct-slot '(:in-layer :in)) collect direct-slot
else collect (list* :in-layer in-layer direct-slot))
initargs))
(defmethod reinitialize-instance :around
((class standard-class-in-layer) &rest initargs
&key (direct-slots () direct-slots-p) (in-layer 't))
(declare (dynamic-extent initargs))
(if direct-slots-p
(apply #'call-next-method class
:direct-slots
(loop for direct-slot in direct-slots
if (get-properties direct-slot '(:in-layer :in)) collect direct-slot
else collect (list* :in-layer in-layer direct-slot))
initargs)
(call-next-method)))
|