Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
gendl
gendl
Commits
f0b92f8c
Commit
f0b92f8c
authored
Nov 03, 2015
by
Dave Cooper
Browse files
added define-object-macro-toplevel macro.
parent
c16a9011
Changes
4
Hide whitespace changes
Inline
Side-by-side
base/source/package.lisp
View file @
f0b92f8c
...
...
@@ -147,6 +147,7 @@ If you are interested in this effort we would love to hear from you at open-sour
#:define-object
#:define-object-amendment
#:define-object-documentation
#:define-object-macro-toplevel
#:define-package
#:define-skin
#:define-view
...
...
base/source/parameters.lisp
View file @
f0b92f8c
...
...
@@ -124,6 +124,12 @@ compared to applications compiled with it set to T. Defaults to NIL.")
:objects
:quantified-objects
:hidden-objects
:quantified-hidden-objects
:functions
:query-slots
))
(
defparameter
*allowed-define-object-toplevel-keywords*
(
list
:input-slots
:computed-slots
:objects
:hidden-objects
:functions
Sreeram Bhaskara
@sbhaskara
·
Jan 27, 2016
Why is :query-slots missing from
allowed-define-object-toplevel-keywords
list?
Why is :query-slots missing from *allowed-define-object-toplevel-keywords* list?
Please
register
or
sign in
to reply
:methods
:trickle-down-slots
:cached-functions
:cached-methods
))
(
defparameter
*define-object-toplevel-macros*
(
make-hash-table
))
(
defparameter
*stream*
nil
)
(
defparameter
*colors-default*
(
list
:foreground
:black
:background
:white
)
...
...
base/source/utilities.lisp
View file @
f0b92f8c
...
...
@@ -386,12 +386,41 @@ You have a dependency on caffeine. Your children are your dependants.
(
defun
same-tree?
(
obj1
obj2
)
(
eql
(
gdl-acc::%root%
obj1
)
(
gdl-acc::%root%
obj2
)))
(
defun
merge-common-keys
(
plist
)
;; FLAG - call recursively until no more non-standard keywords remain.
(
setq
plist
(
expand-define-object-macros-toplevel
plist
))
(
print-variables
plist
)
(
let
((
ht
(
make-hash-table
))
result
)
(
mapc
#'
(
lambda
(
key
value
)
(
let
((
current
(
gethash
key
ht
)))
;; FLAG consider nconc here.
(
setf
(
gethash
key
ht
)
(
if
current
(
append
current
value
)
value
))))
(
plist-keys
plist
)
(
plist-values
plist
))
(
maphash
#'
(
lambda
(
key
value
)
(
push
key
result
)
(
push
value
result
))
ht
)
(
nreverse
result
)))
(
defun
expand-define-object-macros-toplevel
(
plist
)
(
let
(
standards
expansions
)
(
mapc
#'
(
lambda
(
keyword
contents
)
(
if
(
member
keyword
*allowed-define-object-toplevel-keywords*
)
(
let
((
current
(
list
keyword
contents
)))
(
if
standards
(
nconc
standards
current
)
(
setq
standards
current
)))
(
let
((
expansion
(
expand-object-macro-toplevel
keyword
contents
)))
(
if
expansions
(
nconc
expansions
expansion
)
(
setq
expansions
expansion
)))))
(
plist-keys
plist
)(
plist-values
plist
))
(
append
standards
expansions
)))
(
defmacro
define-object-macro-toplevel
(
keyword
(
specs
)
&body
body
)
`
(
defmethod
expand-object-macro-toplevel
((
keyword
(
eql
,
keyword
))
,
specs
)
,@
body
))
(
defgeneric
expand-object-macro-toplevel
(
keyword
specs
))
(
defmethod
expand-object-macro-toplevel
((
keyword
t
)
specs
)
(
declare
(
ignore
specs
))
(
error
"~&~%~%No such toplevel define-object keyword exists as ~s.~%~%"
keyword
))
(
defclass
gdl-basis
()
()
(
:metaclass
gdl-class
))
(
defclass
gdl-remote
()
()
(
:metaclass
gdl-class
))
...
...
regression/base/syntax.lisp
0 → 100644
View file @
f0b92f8c
(
in-package
:gdl-user
)
(
define-object-macro-toplevel
:super-inputs
(
messages
)
`
(
:input-slots
,
messages
))
(
define-object
toplevel
()
:super-inputs
(
hey
now
))
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment