looking for initargs of make-instance

[bill@cambridge.apple.com (Bill St. Clair)]

At  5:35 PM 7/5/93 +0000, Karsten Poeck wrote:
>In article <9307051608.AA21343@cambridge.apple.com>,
>bill@cambridge.apple.com (Bill St. Clair) wrote:
>> (ccl::class-make-instance-initargs class)
>> returns a list of the valid initargs for (make-instance class).
>> The "class" argument can be a class or a symbol naming a class.
>> 
>
>This does not works for me if I have specified a &key &allow-other-keys in
>the initialize-instance: e.g.
>
>(defclass test (window)
>  ())
>
>(defmethod initialize-instance ((ich test)
>                                &rest init-list
>                                &key &allow-other-keys)
>  (declare (ignore init-list))
>  )
>
>(ccl::class-make-instance-initargs (find-class 'test))
>
>-->
>
>> Error: value T is not of the expected type Sequence.
>> While executing: Ccl::Concat-To-List*
>> Type Command-. to abort.
>See the RestartsI menu item for further choices.

You have discovered that CLASS-MAKE-INSTANCE-INITARGS has not been
tested very much. MCL doesn't use it (though it does use the
functions that it calls). In this case, all initargs will be accepted
due to the &ALLOW-OTHER-KEYS in your INITIALIZE-INSTANCE method. Load
the included patch, and your CLASS-MAKE-INSTANCE-INITARGS call will
return T instead of signalling an error.

>
>ccl::class-make-instance-initargs would be extremly usefull for us,
>if it would work for this situation also. Normally we build nested
>dialog-items,
>where the outermost dialog-item gets all the initargs, filters then and
>passes them to the inner dialog-items. 
>
>Do you have a hint how we could extend ccl::class-make-instance-initargs to
>this situation

Here is MCL's code that figures out the valid initargs. Sounds as if
you want a modified version of COMPUTE-INITARGS-VECTGOR that doesn't
treat &ALLOW-OTHER-KEYS ($LFBITS-AOK-BIT) specially. Note that this
code is likely to change in future versions of MCL (though I have no
plans to change it for MCL 3.0). Note that this code caches its
results in special slots in the class. If you want to cache your
results, you can use the CCL::%CLASS-ALIST, accessed via
CCL::%CLASS-GET (SETFable).

--------------------------------------------------------------------------------------

(in-package :ccl)

(require "LISPEQU")    ; for $lfbits-aok-bit

(defun initargs-vector (instance class functions)
  (let ((index (cadr (assq (car functions) *initialization-invalidation-alist*))))
    (unless index
      (error "Unknown initialization function: ~s." (car functions)))
    (let ((initvect (%svref class index)))
      (unless initvect
        (setf (%svref class index) 
              (setq initvect (compute-initargs-vector instance class functions))))
      initvect)))

(defun compute-initargs-vector (instance class functions)
  (let ((initargs (class-slot-initargs class))
        (cpl (%inited-class-cpl class)))
    (dolist (f functions)         ; for all the functions passed
      (dolist (method (%gf-methods f))   ; for each applicable method
        (let ((spec (car (%method-specializers method))))
          (when (if (listp spec)
                  (eql instance (cadr (the list spec)))
                  (memq spec cpl))
            (let* ((func (%inner-method-function method))
                   (keyvect (if (logbitp $lfbits-aok-bit (lfun-bits func))
                              (return-from compute-initargs-vector t)
                              (lfun-keyvect func))))
              (dovector (key keyvect)
                (pushnew key initargs)))))))   ; add all of the method's keys
    (apply #'vector initargs)))

; A useful function
(defun class-make-instance-initargs (class)
  (setq class (require-type (if (symbolp class) (find-class class) class)
                            'std-class))
  (flet ((iv (class &rest functions)
           (declare (dynamic-extent functions))
           (initargs-vector (class-prototype class) class functions)))
    (let ((initvect (apply #'iv
                           class
                           #'initialize-instance #'allocate-instance #'shared-initialize
                           (aux-init-functions class))))
      (if (eq initvect 't)   ; This test was added in "initargs-patch".
        t
        (concatenate 'list initvect)))))

(This file must be converted with BinHex 4.0)

:%fPZDA4KFQGc,A"KG'0S,QCKFf`!4N&66%0$6$)!!!!!!bS!!!!!p,Ir!!!"!!!
!$!!!!alr*!)!J!!#!!!!!`38)"i!!!!!#!&1V4!!)$`!!!!!)m!!!!!)@%p1GEB
!!`-*+Q0ME$T`BA4MD'9c)("[Fh3J-Li`CM-lD@jTG'&bCh-YF'&dBfJZE'PcF!f
1!d0$6"SU6%p"4%P14be'58a&,90299*$45e'58a&+J38)"i!!!!!#!&1V4!!)$`
!!!!!H!4B6dlj!!!!%'d!"3-*!d0$6!d$!!!,8d98,9""3dY"4d8%&#")!!!!!!J
"6Ud3!#d-,3`J,J!%)(`!!!!)6Ud2D#!Z!!`JI!!!!!K1V3pS)M`!!!!!)!a1V3l
-)$`!!!!!GJ&1l3ZSYJ!'"3F($3-!!")U9d&56Le*4Le5484&4NP145S0!`!!'5T
A39*1,8P',9*&4%9'58j&,8Y&8Nj&6#S8)+S!!!%"*J&1V4!8,38U!#!&6UdA4QB
1)!9i"%kj!!!!%#)!B!)L"5!m!!!!!(J)6VN!!!!3+J!Y"5"m!!!!%#dS!!)JI!!
!!"!Y+!!#)(`!!!!3,5J!!L!&H!41Z3!!!""i%%kY$ra1Z3!!!!!Y!#!@X+hqq'B
-)!aF3#aI+Llrr%je)M`!!!!!)"BU,J!%H!JXAdlj!!!!%!!!!!#%3!!##!i'"`8
&"33'#`f1#d0268e26Le-5903#NC*6N3Y3da"8e-0!`!!#9084#e$6%&68`d$!!!
-8N9498P545e8@9"&$3-!!40*6NP858&-59T&,8P18e4"6N0&$3-!!4&"6%a23d&
845e*6P0838j$43d$!!%48dK"8N9%,8P1594*38a*@N80!`!!%N&9@#e*6NP8,8C
96N0858p18a3J2!!!J3%!!8kY$T3!"#!Z!!4i"%kj!!!!%#3!)Li!"#!@H!`JI!!
!!""1V3j36Ud11%lY$k!!!!!!!!J)"`d$!!!23da"8e-Y8&*29%p8@9"&$3-!!!p
*6NP839*(8be@48086e)0!`!!!NP@$3-!!34-5908$3-!!3Y$6dj$394&6N&84Bd
$!!!F3da"8e-Y68&,45e*6P0838j$45e*6NP839*(8`-!![mDm!!!: