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
4c0b8f40
Commit
4c0b8f40
authored
Mar 17, 2015
by
Dave Cooper
Browse files
added generalized check for reserved words (i.e. non-inputs) in internal primitives
parent
6f979848
Changes
11
Hide whitespace changes
Inline
Side-by-side
base/expanders/source/objects.lisp
View file @
4c0b8f40
...
...
@@ -140,11 +140,16 @@ and then compile this again.~%"))
(
safe-sort
(
set-difference
attempted-inputs
accepted-inputs
)
#'
string-lessp
:key
#'
string
)))
;;
;; FLAG -- do we really need to do this here? We are already
;; checking for non-inputs, and the reserved words will all
;; be non-inputs.
;;
(
reserved-word-warning-or-error
part-type-symbol
(
mapcar
#'
(
lambda
(
symbol
)
(
glisp:intern
symbol
:gdl-acc
))
attempted-inputs
))
attempted-inputs
)
(
list
part-type-symbol
)
)
(
when
unrecognized-inputs
(
let*
((
singular?
(
=
(
length
unrecognized-inputs
)
1
))
...
...
base/macros/source/define-object.lisp
View file @
4c0b8f40
...
...
@@ -378,192 +378,196 @@ overview of <tt>define-object</tt> syntax."
(
with-gdl-message-symbols
(
:new
t
)
(
reserved-word-warning-or-error
name
messages
)
(
let
((
mixins
(
if
(
or
no-vanilla-mixin?
(
some
#'
(
lambda
(
mixin
)
(
let
((
class
(
find-class
mixin
nil
)))
(
and
class
(
member
(
find-class
'vanilla-mixin
)
(
all-superclasses
class
)))))
mixin-list
))
mixin-list
(
append
mixin-list
(
list
'vanilla-mixin
)))))
(
let
((
message-ht
(
make-hash-table
:size
(
length
messages
))))
(
dolist
(
message
messages
)
(
push
message
(
gethash
message
message-ht
)))
(
let
((
duplicates
(
let
(
duplicates
)
(
maphash
#'
(
lambda
(
key
val
)(
if
(
consp
(
rest
val
))
(
push
key
duplicates
)))
message-ht
)
duplicates
)))
(
let
((
duplicates
(
remove-if
#'
(
lambda
(
dup
)
(
member
dup
method-syms
))
duplicates
)))
(
when
duplicates
(
error
"duplicate slot name~p: ~{~a~^, ~}"
(
length
duplicates
)
(
sort
duplicates
#'
string-lessp
:key
#'
symbol-name
))))))
(
reserved-word-warning-or-error
name
messages
mixins
)
`
(
progn
(
defclass
,
name
,
(
if
(
or
no-vanilla-mixin?
(
some
#'
(
lambda
(
mixin
)
(
let
((
class
(
find-class
mixin
nil
)))
(
and
class
(
member
(
find-class
'vanilla-mixin
)
(
all-superclasses
class
)))))
mixin-list
))
mixin-list
(
append
mixin-list
(
list
'vanilla-mixin
)))
(
,@
(
append
(
make-standard-slots
)
(
make-accessible-slots
computed-slot-syms
)
(
make-accessible-slots
settable-computed-slot-syms
)
(
make-accessible-slots
uncached-computed-slot-syms
)
(
make-accessible-slots
query-slot-syms
)
(
make-accessible-slots
object-syms
)
(
make-accessible-slots
quantified-object-syms
)
(
make-accessible-slots
hidden-object-syms
)
(
make-accessible-slots
quantified-hidden-object-syms
)
(
make-accessible-slots
cached-function-syms
)
(
make-accessible-slots
cached-method-syms
)
(
make-accessible-slots
required-input-slot-syms
:inputs?
t
)
(
make-accessible-slots
optional-input-slot-syms
:inputs?
t
)
(
make-accessible-slots
settable-input-slot-syms
:inputs?
t
)
(
make-accessible-slots
defaulted-input-slot-syms
:inputs?
t
)
(
make-accessible-slots
settable-defaulted-input-slot-syms
:inputs?
t
)))
(
:metaclass
gdl-class
))
(
let
((
,
class-arg
(
find-class
',name
)))
(
let
((
message-ht
(
make-hash-table
:size
(
length
messages
))))
(
dolist
(
message
messages
)
(
push
message
(
gethash
message
message-ht
)))
(
let
((
duplicates
(
let
(
duplicates
)
(
maphash
#'
(
lambda
(
key
val
)
(
if
(
consp
(
rest
val
))
(
push
key
duplicates
)))
message-ht
)
duplicates
)))
(
let
((
duplicates
(
remove-if
#'
(
lambda
(
dup
)
(
member
dup
method-syms
))
duplicates
)))
(
when
duplicates
(
error
"duplicate slot name~p: ~{~a~^, ~}"
(
length
duplicates
)
(
sort
duplicates
#'
string-lessp
:key
#'
symbol-name
))))))
`
(
progn
(
defclass
,
name
,
mixins
(
,@
(
append
(
make-standard-slots
)
(
make-accessible-slots
computed-slot-syms
)
(
make-accessible-slots
settable-computed-slot-syms
)
(
make-accessible-slots
uncached-computed-slot-syms
)
(
make-accessible-slots
query-slot-syms
)
(
make-accessible-slots
object-syms
)
(
make-accessible-slots
quantified-object-syms
)
(
make-accessible-slots
hidden-object-syms
)
(
make-accessible-slots
quantified-hidden-object-syms
)
(
make-accessible-slots
cached-function-syms
)
(
make-accessible-slots
cached-method-syms
)
(
make-accessible-slots
required-input-slot-syms
:inputs?
t
)
(
make-accessible-slots
optional-input-slot-syms
:inputs?
t
)
(
make-accessible-slots
settable-input-slot-syms
:inputs?
t
)
(
make-accessible-slots
defaulted-input-slot-syms
:inputs?
t
)
(
make-accessible-slots
settable-defaulted-input-slot-syms
:inputs?
t
)))
(
:metaclass
gdl-class
))
(
let
((
,
class-arg
(
find-class
',name
)))
(
let
((
,
old-message-keys
(
messages
,
class-arg
))
(
,
new-message-keys
',messages
))
(
dolist
(
key
(
set-difference
,
old-message-keys
,
new-message-keys
))
(
let
((
method
(
ignore-errors
(
find-method
(
symbol-function
(
glisp:intern
(
symbol-name
key
)
:gdl-slots
))
nil
(
list
,
class-arg
)
nil
))))
(
when
method
(
when
*report-gdl-redefinitions?*
(
format
t
"~%Removing slot: ~a for object definition: ~s~%"
key
',name
))
(
remove-method
(
symbol-function
(
glisp:intern
(
symbol-name
key
)
:gdl-slots
))
method
)))))
,
(
when
(
and
*compile-documentation-database?*
documentation
)
`
(
when
*load-documentation-database?*
(
setf
(
gdl-documentation
,
class-arg
)
',documentation
))))
(
let
((
,
old-message-keys
(
messages
,
class-arg
))
(
,
new-message-keys
',messages
))
(
dolist
(
key
(
set-difference
,
old-message-keys
,
new-message-keys
))
(
let
((
method
(
ignore-errors
(
find-method
(
symbol-function
(
glisp:intern
(
symbol-name
key
)
:gdl-slots
))
nil
(
list
,
class-arg
)
nil
))))
(
when
method
(
when
*report-gdl-redefinitions?*
(
format
t
"~%Removing slot: ~a for object definition: ~s~%"
key
',name
))
(
remove-method
(
symbol-function
(
glisp:intern
(
symbol-name
key
)
:gdl-slots
))
method
)))))
,
(
when
(
and
*compile-documentation-database?*
documentation
)
`
(
when
*load-documentation-database?*
(
setf
(
gdl-documentation
,
class-arg
)
',documentation
))))
(
when
(
message-documentation
(
find-class
',name
))
(
clrhash
(
message-documentation
(
find-class
',name
))))
(
when
(
message-source
(
find-class
',name
))(
clrhash
(
message-source
(
find-class
',name
))))
(
setf
(
messages
(
find-class
',name
))
',messages
)
(
setf
(
required-input-slots
(
find-class
',name
))
',required-input-slot-syms
)
(
setf
(
optional-input-slots
(
find-class
',name
))
',optional-input-slot-syms
)
(
setf
(
defaulted-input-slots
(
find-class
',name
))
',defaulted-input-slot-syms
)
(
setf
(
computed-slots
(
find-class
',name
))
',computed-slot-syms
)
(
setf
(
query-slots
(
find-class
',name
))
',query-slot-syms
)
(
setf
(
settable-computed-slots
(
find-class
',name
))
',settable-computed-slot-syms
)
(
setf
(
uncached-computed-slots
(
find-class
',name
))
',uncached-computed-slot-syms
)
(
setf
(
settable-optional-input-slots
(
find-class
',name
))
',settable-input-slot-syms
)
(
setf
(
settable-defaulted-input-slots
(
find-class
',name
))
',settable-defaulted-input-slot-syms
)
(
setf
(
functions
(
find-class
',name
))
',function-syms
)
(
setf
(
methods
(
find-class
',name
))
',method-syms
)
(
setf
(
cached-functions
(
find-class
',name
))
',cached-function-syms
)
(
setf
(
cached-methods
(
find-class
',name
))
',cached-method-syms
)
(
setf
(
objects
(
find-class
',name
))
',object-syms
)
(
setf
(
quantified-objects
(
find-class
',name
))
',quantified-object-syms
)
(
setf
(
hidden-objects
(
find-class
',name
))
',hidden-object-syms
)
(
setf
(
quantified-hidden-objects
(
find-class
',name
))
',quantified-hidden-object-syms
)
(
setf
(
trickle-down-slots
(
find-class
',name
))
',
(
append
object-syms
quantified-object-syms
hidden-object-syms
quantified-hidden-object-syms
trickle-down-slot-syms
))
(
setf
(
settable-slots
(
find-class
',name
))
',
(
append
required-input-slot-syms
settable-input-slot-syms
settable-defaulted-input-slot-syms
settable-computed-slot-syms
))
;; FLAG -- consider pre-cooking these expression lists
;;
,@
(
message-generics
(
set-difference
messages
(
append
method-syms
cached-method-syms
)))
,
(
input-slots-generics
(
append
(
group-remark-strings
(
remove-if-not
#'
(
lambda
(
item
)
(
or
(
symbolp
item
)
(
stringp
item
)))
input-slots
))
(
remove-if-not
#'
consp
input-slots
)))
,@
(
input-slots-section
name
(
group-remark-strings
(
remove-if-not
#'
(
lambda
(
item
)
(
or
(
symbolp
item
)
(
stringp
item
)))
input-slots
)))
,@
(
optional-input-slots-section
name
(
remove-if-not
#'
(
lambda
(
slot
)
(
and
(
consp
slot
)
(
null
(
rest
(
rest
(
strip-strings
slot
))))))
input-slots
))
,@
(
optional-input-slots-section
name
(
remove-if-not
#'
(
lambda
(
slot
)
(
and
(
consp
slot
)
(
member
:settable
(
rest
(
rest
(
strip-strings
slot
))))
(
not
(
member
:defaulting
(
rest
(
rest
(
strip-strings
slot
)))))))
input-slots
))
,@
(
optional-input-slots-section
name
(
remove-if-not
#'
(
lambda
(
slot
)
(
and
(
consp
slot
)
(
member
:defaulting
(
rest
(
rest
(
strip-strings
slot
))))
(
not
(
member
:settable
(
rest
(
rest
(
strip-strings
slot
)))))))
input-slots
)
t
)
,@
(
optional-input-slots-section
name
(
remove-if-not
#'
(
lambda
(
slot
)
(
and
(
consp
slot
)
(
member
:settable
(
rest
(
rest
(
strip-strings
slot
))))
(
member
:defaulting
(
rest
(
rest
(
strip-strings
slot
))))))
input-slots
)
t
)
(
when
(
message-documentation
(
find-class
',name
))
(
clrhash
(
message-documentation
(
find-class
',name
))))
(
when
(
message-source
(
find-class
',name
))(
clrhash
(
message-source
(
find-class
',name
))))
(
setf
(
messages
(
find-class
',name
))
',messages
)
(
setf
(
required-input-slots
(
find-class
',name
))
',required-input-slot-syms
)
(
setf
(
optional-input-slots
(
find-class
',name
))
',optional-input-slot-syms
)
(
setf
(
defaulted-input-slots
(
find-class
',name
))
',defaulted-input-slot-syms
)
(
setf
(
computed-slots
(
find-class
',name
))
',computed-slot-syms
)
(
setf
(
query-slots
(
find-class
',name
))
',query-slot-syms
)
(
setf
(
settable-computed-slots
(
find-class
',name
))
',settable-computed-slot-syms
)
(
setf
(
uncached-computed-slots
(
find-class
',name
))
',uncached-computed-slot-syms
)
(
setf
(
settable-optional-input-slots
(
find-class
',name
))
',settable-input-slot-syms
)
(
setf
(
settable-defaulted-input-slots
(
find-class
',name
))
',settable-defaulted-input-slot-syms
)
(
setf
(
functions
(
find-class
',name
))
',function-syms
)
(
setf
(
methods
(
find-class
',name
))
',method-syms
)
(
setf
(
cached-functions
(
find-class
',name
))
',cached-function-syms
)
(
setf
(
cached-methods
(
find-class
',name
))
',cached-method-syms
)
(
setf
(
objects
(
find-class
',name
))
',object-syms
)
(
setf
(
quantified-objects
(
find-class
',name
))
',quantified-object-syms
)
(
setf
(
hidden-objects
(
find-class
',name
))
',hidden-object-syms
)
(
setf
(
quantified-hidden-objects
(
find-class
',name
))
',quantified-hidden-object-syms
)
(
setf
(
trickle-down-slots
(
find-class
',name
))
',
(
append
object-syms
quantified-object-syms
hidden-object-syms
quantified-hidden-object-syms
trickle-down-slot-syms
))
(
setf
(
settable-slots
(
find-class
',name
))
',
(
append
required-input-slot-syms
settable-input-slot-syms
settable-defaulted-input-slot-syms
settable-computed-slot-syms
))
;; FLAG -- consider pre-cooking these expression lists
;;
,@
(
message-generics
(
set-difference
messages
(
append
method-syms
cached-method-syms
)))
,
(
input-slots-generics
(
append
(
group-remark-strings
(
remove-if-not
#'
(
lambda
(
item
)
(
or
(
symbolp
item
)
(
stringp
item
)))
input-slots
))
(
remove-if-not
#'
consp
input-slots
)))
,@
(
input-slots-section
name
(
group-remark-strings
(
remove-if-not
#'
(
lambda
(
item
)
(
or
(
symbolp
item
)
(
stringp
item
)))
input-slots
)))
,@
(
optional-input-slots-section
name
(
remove-if-not
#'
(
lambda
(
slot
)
(
and
(
consp
slot
)
(
null
(
rest
(
rest
(
strip-strings
slot
))))))
input-slots
))
,@
(
optional-input-slots-section
name
(
remove-if-not
#'
(
lambda
(
slot
)
(
and
(
consp
slot
)
(
member
:settable
(
rest
(
rest
(
strip-strings
slot
))))
(
not
(
member
:defaulting
(
rest
(
rest
(
strip-strings
slot
)))))))
input-slots
))
,@
(
optional-input-slots-section
name
(
remove-if-not
#'
(
lambda
(
slot
)
(
and
(
consp
slot
)
(
member
:defaulting
(
rest
(
rest
(
strip-strings
slot
))))
(
not
(
member
:settable
(
rest
(
rest
(
strip-strings
slot
)))))))
input-slots
)
t
)
,@
(
optional-input-slots-section
name
(
remove-if-not
#'
(
lambda
(
slot
)
(
and
(
consp
slot
)
(
member
:settable
(
rest
(
rest
(
strip-strings
slot
))))
(
member
:defaulting
(
rest
(
rest
(
strip-strings
slot
))))))
input-slots
)
t
)
,@
(
computed-slots-section
name
(
remove-if-not
#'
(
lambda
(
slot
)
(
and
(
consp
slot
)
(
null
(
rest
(
rest
(
strip-strings
slot
))))))
computed-slots
))
,@
(
computed-slots-section
name
(
remove-if-not
#'
(
lambda
(
slot
)
(
and
(
consp
slot
)
(
null
(
rest
(
rest
(
strip-strings
slot
))))))
computed-slots
))
,@
(
computed-slots-section
name
(
remove-if-not
#'
(
lambda
(
slot
)
(
and
(
consp
slot
)
(
eql
(
first
(
rest
(
rest
(
strip-strings
slot
))))
:settable
)))
computed-slots
))
,@
(
computed-slots-section
name
(
remove-if-not
#'
(
lambda
(
slot
)
(
and
(
consp
slot
)
(
eql
(
first
(
rest
(
rest
(
strip-strings
slot
))))
:settable
)))
computed-slots
))
,@
(
computed-slots-section
name
query-slots
:query?
t
)
,@
(
computed-slots-section
name
query-slots
:query?
t
)
,@
(
objects-section
name
(
append
objects
hidden-objects
))
,@
(
objects-section
name
(
append
objects
hidden-objects
))
,@
(
functions-section
name
(
mapcar
#'
(
lambda
(
slot
)
(
if
(
stringp
(
first
slot
))
(
list
(
first
slot
)
(
second
slot
)
nil
(
third
slot
))
(
list
(
first
slot
)
nil
(
second
slot
))))
(
remove-if-not
#'
(
lambda
(
slot
)
(
and
(
consp
slot
)
(
eql
(
first
(
rest
(
rest
(
strip-strings
slot
))))
:uncached
)))
computed-slots
)))
,@
(
functions-section
name
(
mapcar
#'
(
lambda
(
slot
)
(
if
(
stringp
(
first
slot
))
(
list
(
first
slot
)
(
second
slot
)
nil
(
third
slot
))
(
list
(
first
slot
)
nil
(
second
slot
))))
(
remove-if-not
#'
(
lambda
(
slot
)
(
and
(
consp
slot
)
(
eql
(
first
(
rest
(
rest
(
strip-strings
slot
))))
:uncached
)))
computed-slots
)))
,@
(
functions-section
name
functions
)
,@
(
functions-section
name
functions
)
,@
(
methods-section
name
methods
)
,@
(
methods-section
name
methods
)
,@
(
trickle-down-slots-section
trickle-down-slot-syms
)
,@
(
trickle-down-slots-section
trickle-down-slot-syms
)
,@
(
trickle-down-slots-section
(
append
object-syms
quantified-object-syms
hidden-object-syms
quantified-hidden-object-syms
)
:from-objects?
t
)
,@
(
trickle-down-slots-section
(
append
object-syms
quantified-object-syms
hidden-object-syms
quantified-hidden-object-syms
)
:from-objects?
t
)
#+
nil
(
defmethod
gdl-rule::%object-keywords%
((
,
self-arg
,
name
))
(
remove-duplicates
(
append
',object-syms
',quantified-object-syms
(
when
(
next-method-p
)
(
call-next-method
)))))
#+
nil
(
defmethod
gdl-rule::%object-keywords%
((
,
self-arg
,
name
))
(
remove-duplicates
(
append
',object-syms
',quantified-object-syms
(
when
(
next-method-p
)
(
call-next-method
)))))
#+
nil
(
defmethod
gdl-rule::%hidden-object-keywords%
((
,
self-arg
,
name
))
(
remove-duplicates
(
append
',hidden-object-syms
',quantified-hidden-object-syms
(
when
(
next-method-p
)
(
call-next-method
)))))
#+
nil
(
defmethod
gdl-rule::%hidden-object-keywords%
((
,
self-arg
,
name
))
(
remove-duplicates
(
append
',hidden-object-syms
',quantified-hidden-object-syms
(
when
(
next-method-p
)
(
call-next-method
)))))
;;
;; FLAG -- maybe some of these others can go away as well.
;;
;;
;; FLAG -- maybe some of these others can go away as well.
;;
(
let
((
,
self-arg
(
find-class
',name
nil
)))
(
when
,
self-arg
(
setf
(
trickle-down-effective
,
self-arg
)
nil
)))
(
let
((
,
self-arg
(
find-class
',name
nil
)))
(
when
,
self-arg
(
setf
(
trickle-down-effective
,
self-arg
)
nil
)))
;;
;; FLAG -- use uiop:list-to-hash-set
;;
(
defmethod
gdl-rule::%trickle-down-slots%
;;
;; FLAG -- use uiop:list-to-hash-set
;;
(
defmethod
gdl-rule::%trickle-down-slots%
((
,
self-arg
,
name
))
(
let
((
class
(
class-of
,
self-arg
)))
(
or
(
trickle-down-effective
class
)
...
...
@@ -640,7 +644,7 @@ overview of <tt>define-object</tt> syntax."
(
when
(
and
(
not
(
eql
,
message-type-arg
:local
))
(
next-method-p
))
(
call-next-method
,
self-arg
,
category-arg
,
message-type-arg
,
base-part-type-arg
(
1+
,
depth-arg
)))))
(
find-class
',name
))))
(
find-class
',name
))))
)
...
...
base/macros/source/message-utils.lisp
View file @
4c0b8f40
...
...
@@ -159,18 +159,44 @@
(
setq
current-remark-string
nil
on-message?
nil
))))))
(
defparameter
*reserved-word-protected-packages*
(
list
(
find-package
:gdl
)
(
find-package
:geom-base
)
(
find-package
:surf
)))
(
defun
reserved-word-warning-or-error
(
name
messages
)
(
unless
(
and
(
atom
name
)
(
or
(
member
(
symbol-package
name
)
*reserved-word-protected-packages*
)))
(
let
((
reserved-violations
(
intersection
messages
+reserved-words+
)))
(
defparameter
*reserved-words-hash*
(
make-hash-table
))
;;
;; FLAG -- consider a scheme for controlling the overriding of your
;; own mixins as well, perhaps allowing for a list of
;; overridable-slots.
;;
(
defun
reserved-words-for
(
mixins
)
(
apply
#'
append
(
mapcar
#'
(
lambda
(
mixin
)
(
when
(
member
(
glisp:intern
(
package-name
(
symbol-package
mixin
))
:keyword
)
*packages-to-lock*
)
(
or
(
gethash
mixin
*reserved-words-hash*
)
(
setf
(
gethash
mixin
*reserved-words-hash*
)
(
mapcar
#'
(
lambda
(
word
)
(
glisp:intern
word
:gdl-acc
))
(
set-difference
(
the-object
(
make-object
mixin
)
message-list
)
(
append
(
the-object
(
make-object
mixin
)
(
message-list
:category
:required-input-slots
))
(
the-object
(
make-object
mixin
)
(
message-list
:category
:optional-input-slots
))
(
the-object
(
make-object
mixin
)
(
message-list
:category
:settable-optional-input-slots
))
(
the-object
(
make-object
mixin
)
(
message-list
:category
:defaulted-input-slots
))
(
the-object
(
make-object
mixin
)
(
message-list
:category
:settable-defaulted-input-slots
)))))))))
mixins
)))
(
defun
reserved-word-warning-or-error
(
name
messages
mixins
)
(
unless
(
and
(
atom
name
)
(
member
(
glisp:intern
(
package-name
(
symbol-package
name
))
:keyword
)
*packages-to-lock*
))
(
let*
((
reserved-words
(
reserved-words-for
mixins
))
(
reserved-violations
(
intersection
messages
reserved-words
))
(
length
(
length
reserved-violations
)))
(
when
reserved-violations
(
let
((
is-or-are
(
if
(
=
(
length
reserved-violations
)
1
)
"is"
"are"
))
(
s-or-blank
(
if
(
=
(
length
reserved-violations
)
1
)
""
"s"
))
(
a-or-blank
(
if
(
=
(
length
reserved-violations
)
1
)
"a "
""
)))
(
let
((
is-or-are
(
if
(
=
length
1
)
"is"
"are"
))
(
s-or-blank
(
if
(
=
length
1
)
""
"s"
))
(
a-or-blank
(
if
(
=
length
1
)
"a "
""
)))
(
funcall
(
if
*error-on-reserved-words?*
#'
error
...
...
base/source/parameters.lisp
View file @
4c0b8f40
...
...
@@ -210,3 +210,6 @@ values are a color indicator for the default foreground and background of graphi
:tasty
:robot
:tree
:yadd
:surf
:smlib
:genworks-gdl
))
(
defvar
*quicklisp-home*
nil
)
(
defvar
*packages-to-lock*
(
list
:gendl
:geom-base
:cl-lite
:gwl
:gwl-graphics
:tasty
:robot
:tree
:yadd
:surf
:smlib
:genworks-gdl
))
gwl/form-elements/source/ignore-list.isc
deleted
100755 → 0
View file @
6f979848
;;
;; Copyright 2002-2011 Genworks International and Genworks BV
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
("tests")
gwl/gwl.asd
View file @
4c0b8f40
;;;; -*- coding: utf-8 -*-
(
asdf:defsystem
#:gwl
:description
"The Gendl™ Generative Web Language (GWL)"
:author
"John McCarthy"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20150122"
:depends-on
(
asdf:defsystem
#:gwl
:description
"The Gendl™ Generative Web Language (GWL)"
:author
"Dave Cooper"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20150317"
:depends-on
(
:bordeaux-threads
:glisp
:aserve
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/defparameters"
)
(
:file
"source/presets"
)
(
:file
"source/base-html-sheet"
)
(
:file
"source/base-html-utils"
)
(
:file
"source/macros"
)
((
:file
"source/package"
)
(
:file
"source/defparameters"
)
(
:file
"source/presets"
)
(
:file
"source/base-html-sheet"
)
(
:file
"source/base-html-utils"
)
(
:file
"source/macros"
)
(
:file
"source/ignore-errors-with-backtrace"
)
(
:file
"source/utilities"
)
(
:file
"source/answer"
)
(
:file
"source/accessories"
)
(
:file
"source/gdl-remote"
)
(
:file
"source/vanilla-remote"
)
(
:file
"source/base64-utils"
)
(
:file
"source/cl-pdf-patches"
)
(
:file
"source/color-palette"
)
(
:file
"source/crawler"
)
(
:file
"source/log-utils"
)
(
:file
"source/new-urls"
)
(
:file
"source/publish"
)
(
:file
"source/utilities"
)
(
:file
"source/answer"
)
(
:file
"source/accessories"
)
(
:file
"source/gdl-remote"
)
(
:file
"source/vanilla-remote"
)
(
:file
"source/base64-utils"
)
(
:file
"source/cl-pdf-patches"
)
(
:file
"source/color-palette"
)
(
:file
"source/crawler"
)
(
:file
"source/log-utils"
)
(
:file
"source/new-urls"
)
(
:file
"source/publish"
)
(
:file
"source/remote-object"
)
(
:file
"source/security-check-failed"
)
(
:file
"form-elements/source/grid-form-element"
)
(
:file
"form-elements/source/macros"
)
(
:file
"form-elements/source/primitives"
)
(
:file
"form-elements/source/short-test"
)
(
:file
"form-elements/source/test-seq"
)
(
:file
"form-elements/source/validation-tests"
)
(
:file
"ajax/source/parameters"
)
(
:file
"ajax/source/ajax"
)
(
:file
"ajax/source/parameters"
)
(
:file
"ajax/source/ajax"
)
(
:file
"ajax/source/base-ajax-sheet"
)
(
:file
"ajax/source/skeleton-ui-element"
)
(
:file
"gwl-session/source/parameters"
)
...
...
@@ -38,4 +54,5 @@
(
:file
"gwl-session/source/session-report"
)
(
:file
"js-libs/jquery/source/package"
)
(
:file
"js-libs/jquery/source/slider-form-control"
)
(
:file
"zzinit/source/initialize"
)
(
:file
"zzinit/source/zzinit"
)))
(
:file
"zzinit/source/initialize"
)
(
:file
"zzinit/source/zzinit"
)))
gwl/source/color-palette.lisp
View file @
4c0b8f40
...
...
@@ -19,7 +19,7 @@
;; <http://www.gnu.org/licenses/>.
;;
(
in-package
:gwl
-user
)
(
in-package
:gwl
)
(
publish
:path
"/color-map"
...
...
gwl
/form-element
s/source/
tests.lisp
→
regression/gwl/source
/form-element
-
tests.lisp
100755 → 100644
View file @
4c0b8f40
File moved
gwl
/form-element
s/source/
validation
-tests
.lisp
→
regression/gwl/source
/form-element
-
validation.lisp
View file @
4c0b8f40
File moved
gwl/form-elements/source/shor
t-test.lisp
→
regression/gwl/source/short-form-elemen
t-test.lisp
100755 → 100644
View file @
4c0b8f40
File moved
gwl/form-elements
/source/test-seq.lisp
→
regression/gwl
/source/test-seq.lisp
100755 → 100644
View file @
4c0b8f40
File moved
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