[aspectl-devel] Some progress...

[Jeff Caldwell]

Hi,

I found my problems with most of the issues. What I
still have not made work is:

(with-class 'person
  (class-add
   :direct-slots
   '(age :accessor age :initarg :age)))


The following fixes my first two errors:

(defpackage test-aspectl (:use :aspectl :cl-user :cl))
(in-package :test-aspectl)

(defvar *some-environment* "This is
*some-environment*!")
(defvar *env-depth* 0)

(defun setup-env (environment)
  (declare (ignore environment))
  (incf *env-depth*))

(defun teardown-env ()
  (decf *env-depth*))

(defmacro with-some-environment ((environment) 
                                  &body body)
  `(let ((*some-environment* (setup-env
,environment)))
     (unwind-protect
         , at body
       (teardown-env))))

(defmethod do-something (args &key &allow-other-keys)
  (format t "~&do-something *some-environment* ~A" 
              *some-environment*))

(defmethod do-something-else (args &key
&allow-other-keys)
  (format t "~&do-something-else *some-environment*
~A" 
              *some-environment*))

(define-pointcut environment-pointcut)
(define-join-point environment-pointcut 
                   do-something)
(define-join-point environment-pointcut 
                   do-something-else)

(define-aspect-weaver environment-pointcut 
                      accept-environment-arg
    (aspect-weaver join-point)
  (declare (ignore aspect-weaver))
  (create-method
   (fdefinition (join-point-name join-point))
   :qualifiers '(:around)
   :lambda-list '(args &key (in-environment 
                             *some-environment*)
                       &allow-other-keys)
   :specializers (list (find-class 't))
   :declarations '((ignore args))
   :body '(progn
            (if (eq in-environment 
                    *some-environment*)
                (call-next-method)
              (with-some-environment 
                (in-environment)
                (call-next-method))))))

Tonight I will try to get over the "now what?" feeling
... now what do I do with the code above? :)

It is now with-special-function-scope instead of
overview.html's with-special-generic-function-scope:

(with-special-function-scope (print-person*)
  (defmethod* print-person* 
     :before ((scope dynamic) person)
    (print "Dynamic!"))
  (print-person-list *pl*))

"Dynamic!" 
"Mr. X" 
"Dynamic!" 
"Mr. Y" 
"Dynamic!" 
"Mr. Z" 

(print-person-list *pl*)
"Mr. X" 
"Mr. Y" 
"Mr. Z" 


Jeff Caldwell


		
__________________________________
Do you Yahoo!?
Yahoo! Mail - 50x more storage than other providers!
http://promotions.yahoo.com/new_mail