git.fiddlerwoaroof.com
server-aware-class.lisp
55a3cfc9
 (defpackage :fwoar.server-aware-class
   (:use :cl )
   (:export
    #:server-aware-class
    #:serializable
    #:publish-value
    #:server))
 (in-package :fwoar.server-aware-class)
 
 (defgeneric publish-value (server class slot old-value new-value)
   )
 
 (defclass server-aware-class (standard-class)
   ((%server :accessor server :initform nil)))
 
 (defclass serializable ()
   ())
 
 (defmethod closer-mop:validate-superclass ((meta server-aware-class) (class standard-class))
   t)
 
 (defmethod (setf closer-mop:slot-value-using-class) :around (new-value (class server-aware-class) object slotd)
   (if (and (server class) (c2mop:slot-boundp-using-class class object slotd))
       (let ((old-value (c2mop:slot-value-using-class class object slotd)))
         (call-next-method)
         (publish-value (server class) (closer-mop:class-prototype class) (closer-mop:slot-definition-name slotd)
                        old-value new-value))
       (call-next-method)))