Commit f0b92f8c authored by Dave Cooper's avatar Dave Cooper

added define-object-macro-toplevel macro.

parent c16a9011
......@@ -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
......
......@@ -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
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)
......
......@@ -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))
......
(in-package :gdl-user)
(define-object-macro-toplevel :super-inputs (messages)
`(:input-slots ,messages))
(define-object toplevel ()
:super-inputs (hey now))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment