/[gcl]/gcl/pcl/pcl_fast_init.lisp
ViewVC logotype

Diff of /gcl/pcl/pcl_fast_init.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by camm, Wed Feb 26 22:21:41 2003 UTC revision 1.2 by camm, Mon Oct 13 21:45:51 2003 UTC
# Line 225  Line 225 
225               (eq *initialize-info-cache-initargs* initargs))               (eq *initialize-info-cache-initargs* initargs))
226          (setq info *initialize-info-cache-info*)          (setq info *initialize-info-cache-info*)
227          (let ((initargs-tail initargs)          (let ((initargs-tail initargs)
228                  allow-other-keys-p
229                (cell (or (class-initialize-info class)                (cell (or (class-initialize-info class)
230                          (setf (class-initialize-info class) (cons nil nil)))))                          (setf (class-initialize-info class) (cons nil nil)))))
231            (loop (when (null initargs-tail) (return nil))            (loop (when (null initargs-tail) (return nil))
232                  (let ((keyword (pop initargs-tail))                  (let ((keyword (pop initargs-tail))
233                        (alist-cell cell))                        (alist-cell cell))
234                    (when plist-p                    (when plist-p
235                      (if (eq keyword :allow-other-keys)                      ;; leftmost occurrence only
236                          (setq allow-other-keys-arg (pop initargs-tail))                      ;; FIXME check that this is correct
237                        (if (and (not allow-other-keys-p) (eq keyword :allow-other-keys))
238                            (progn
239                              (setq allow-other-keys-arg (pop initargs-tail))
240                              (setq allow-other-keys-p t))
241                          (pop initargs-tail)))                          (pop initargs-tail)))
242                    (loop (let ((alist (cdr alist-cell)))                    (loop (let ((alist (cdr alist-cell)))
243                            (when (null alist)                            (when (null alist)
# Line 294  Line 299 
299                          (check-initargs-values class methods)                          (check-initargs-values class methods)
300                        (or (not (null allow-other-keys))                        (or (not (null allow-other-keys))
301                            (dolist (key keys t)                            (dolist (key keys t)
302                              (unless (member key legal)                              (unless (or (member key legal) (eq key :allow-other-keys))
303                                (return (cons :invalid key)))))))))                                (return (cons :invalid key)))))))))
304           (let ((proto (class-prototype class)))           (let ((proto (class-prototype class)))
305             (setf (initialize-info-cached-valid-p info)             (setf (initialize-info-cached-valid-p info)

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26