X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=mop.lisp;h=26fba01e04d3aaa61ab0ab4f5929bfc8d86bf1aa;hb=2d5846f3de4a102ebf123efe7cdb48a78fa94e93;hp=085408e36699cd3d025298d165dd890fb667ffa6;hpb=f57679aba5abb3dc8d7e34c38f94201319a5af29;p=hyperobject.git diff --git a/mop.lisp b/mop.lisp index 085408e..26fba01 100644 --- a/mop.lisp +++ b/mop.lisp @@ -11,7 +11,7 @@ ;;;; in Text, HTML, and XML formats. This includes hyperlinking ;;;; capability and sub-objects. ;;;; -;;;; $Id: mop.lisp,v 1.52 2003/04/15 05:18:22 kevin Exp $ +;;;; $Id: mop.lisp,v 1.59 2003/04/16 20:50:00 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg ;;;; @@ -84,7 +84,7 @@ (defclass hyperlink () ((name :type symbol :initform nil :initarg :name :reader name) - (lookup :type function :initform nil :initarg :lookup :reader lookup) + (lookup :type (or function symbol) :initform nil :initarg :lookup :reader lookup) (link-parameters :type list :initform nil :initarg :link-parameters :reader link-parameters))) @@ -288,8 +288,11 @@ `(defmethod slot-unbound (,the-class (,the-instance ,class) (,the-slot-name (eql ',slot-name))) (declare (ignore ,the-class)) - (setf (slot-value ,the-instance ,the-slot-name) - (,reader ,@keys))))) + (let ((v (,reader ,@keys))) + v + #+ignore + (setf (slot-value ,the-instance ,the-slot-name) v))))) + #+lispworks (defun intern-eql-specializer (slot) @@ -343,12 +346,12 @@ nil (cdr subobj-def))))) (unless (eq (lookup subobject) t) - #-(or sbcl cmu lispworks) + #-(or sbcl lispworks) (eval `(hyperobject::def-lazy-reader ,(name-class subobject) ,(name-slot subobject) ,(lookup subobject) ,@(lookup-keys subobject))) - #+(or sbcl cmu lispworks) + #+(or sbcl lispworks) (apply #'ensure-lazy-reader (name-class subobject) (name-slot subobject) (lookup subobject) (lookup-keys subobject)) )