1 (in-package :lisp-on-lines
)
8 (defun plist-nunion (new-props plist
)
9 "Destructive Merge of plists. PLIST is modified and returned.
10 NEW-PROPS is merged into PLIST such that any properties
11 in both PLIST and NEW-PROPS get the value in NEW-PROPS.
12 The other properties in PLIST are left untouched."
13 (loop for cons on new-props by
#'cddr
14 do
(setf (getf plist
(first cons
)) (second cons
))
15 finally
(return plist
))
18 (defun plist-union (new-props plist
)
19 "Non-destructive version of plist-nunion"
20 (plist-nunion new-props
(copy-list plist
)))
27 (defun slots-as-properties (object)
28 "Makes a plist by making a keyword from the ...ahh .. read the damn code"
31 (when (slot-boundp object slot-name
)
33 (list (intern (symbol-name slot-name
)
34 (find-package :keyword
))
35 (slot-value object slot-name
))))
38 (defun properties-as-slots (plist)
39 "takes a plist and turns it into slot-definitions, interning the key names in *package*"
40 (loop for
(key val
) on plist by
#'cddr
41 collect
(let ((name (intern (symbol-name key
))))
42 `(,name
:accessor
,name
:initarg
,key
:special t
:initform
,val
))))
44 (defmacro with-properties
((properties &optional
(prefix '||
)) &body body
)
45 (with-unique-names (p)
46 (let ((get (intern (strcat prefix
'.get
)))
47 (set (intern (strcat prefix
'.set
)))
48 (props (intern (strcat prefix
'.properties
))))
49 `(let ((,p
,properties
))
56 (declare (ignorable #',get
#',set
#',props
))