/[slime]/slime/swank.lisp
ViewVC logotype

Diff of /slime/swank.lisp

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

revision 1.414 by mbaringer, Wed Nov 1 14:16:36 2006 UTC revision 1.415 by mbaringer, Thu Nov 2 09:34:31 2006 UTC
# Line 3421  a :special-operator, or a :package." Line 3421  a :special-operator, or a :package."
3421                            symbol-or-name))                            symbol-or-name))
3422               symbol-or-name)               symbol-or-name)
3423           internal-p package-name)           internal-p package-name)
3424        (list name score        (list name score
3425              (mapcar              (mapcar
3426               #'(lambda (chunk)               #'(lambda (chunk)
3427                   ;; fix up chunk positions to account for possible                   ;; fix up chunk positions to account for possible
# Line 3460  only the top LIMIT results will be retur Line 3460  only the top LIMIT results will be retur
3460    (declare (type (or null (integer 0 #.(1- most-positive-fixnum))) limit time-limit-in-msec))    (declare (type (or null (integer 0 #.(1- most-positive-fixnum))) limit time-limit-in-msec))
3461    (multiple-value-bind (name package-name package internal-p)    (multiple-value-bind (name package-name package internal-p)
3462        (parse-completion-arguments string default-package-name)        (parse-completion-arguments string default-package-name)
3463      (flet ((convert (vector)      (flet ((convert (vector &optional converter)
3464               (loop for idx :upfrom 0               (when vector
3465                     while (< idx (length vector))                 (loop for idx :upfrom 0
3466                     for el = (aref vector idx)                       while (< idx (length vector))
3467                     do (setf (aref vector idx) (convert-fuzzy-completion-result                       for el = (aref vector idx)
3468                                                  el nil internal-p package-name)))))                       do (setf (aref vector idx) (convert-fuzzy-completion-result
3469                                                     el converter internal-p package-name))))))
3470        (let* ((symbols (and package        (let* ((symbols (and package
3471                             (fuzzy-find-matching-symbols name                             (fuzzy-find-matching-symbols name
3472                                                          package                                                          package
3473                                                          (and (not internal-p)                                                          (and (not internal-p)
3474                                                               package-name)                                                               package-name)
3475                                                          :time-limit-in-msec time-limit-in-msec                                                          :time-limit-in-msec time-limit-in-msec
3476                                                          :return-converted-p t)))                                                          :return-converted-p nil)))
3477               (packs (and (not package-name)               (packs (and (not package-name)
3478                           (fuzzy-find-matching-packages name)))                           (fuzzy-find-matching-packages name)))
3479               (results))               (results))
3480          (convert symbols)          (convert symbols (completion-output-symbol-converter string))
3481          (convert packs)          (convert packs)
3482          (setf results (sort (concatenate 'vector symbols packs) #'> :key #'second))          (setf results (sort (concatenate 'vector symbols packs) #'> :key #'second))
3483          (when (and limit          (when (and limit
# Line 4369  NIL is returned if the list is circular. Line 4370  NIL is returned if the list is circular.
4370                        for name = (swank-mop:slot-definition-name slotd)                        for name = (swank-mop:slot-definition-name slotd)
4371                        collect `(:value ,slotd ,(string name))                        collect `(:value ,slotd ,(string name))
4372                        collect " = "                        collect " = "
4373                        collect (if (swank-mop:slot-boundp-using-class c o slotd)                        collect (if (slot-boundp-using-class-for-inspector c o slotd)
4374                                    `(:value ,(swank-mop:slot-value-using-class                                    `(:value ,(slot-value-using-class-for-inspector
4375                                               c o slotd))                                               c o slotd))
4376                                    "#<unbound>")                                    "#<unbound>")
4377                        collect '(:newline))))))                        collect '(:newline))))))
# Line 4410  See `methods-by-applicability'.") Line 4411  See `methods-by-applicability'.")
4411                       maxlen                       maxlen
4412                       (length doc))))                       (length doc))))
4413    
4414  (defun all-slots-for-inspector (object)  (defgeneric slot-value-using-class-for-inspector (class object slot)
4415    (append (list "------------------------------" '(:newline)    (:method (class object slot)
4416                 "All Slots:" '(:newline))             (swank-mop:slot-value-using-class class object slot)))
4417            (loop  
4418               with direct-slots = (swank-mop:class-direct-slots (class-of object))  (defgeneric slot-boundp-using-class-for-inspector (class object slot)
4419               for slot in (swank-mop:class-slots (class-of object))    (:method (class object slot)
4420               for slot-def = (or (find-if (lambda (a)             (swank-mop:slot-boundp-using-class class object slot)))
4421                                             ;; find the direct slot  
4422                                             ;; with the same name  (defgeneric all-slots-for-inspector (object inspector)
4423                                             ;; as SLOT (an    (:method ((object standard-object) inspector)
4424                                             ;; effective slot).             (append '("------------------------------" (:newline)
4425                                             (eql (swank-mop:slot-definition-name a)                       "All Slots:" (:newline))
4426                                                  (swank-mop:slot-definition-name slot)))                     (loop
4427                                           direct-slots)                         with class = (class-of object)
4428                                  slot)                         with direct-slots = (swank-mop:class-direct-slots (class-of object))
4429               collect `(:value ,slot-def ,(inspector-princ (swank-mop:slot-definition-name slot-def)))                         for slot in (swank-mop:class-slots (class-of object))
4430               collect " = "                         for slot-def = (or (find-if (lambda (a)
4431               if (slot-boundp object (swank-mop:slot-definition-name slot-def))                                                       ;; find the direct slot
4432               collect `(:value ,(slot-value object (swank-mop:slot-definition-name slot-def)))                                                       ;; with the same name
4433               else                                                       ;; as SLOT (an
4434               collect "#<unbound>"                                                       ;; effective slot).
4435               collect '(:newline))))                                                       (eql (swank-mop:slot-definition-name a)
4436                                                              (swank-mop:slot-definition-name slot)))
4437                                                       direct-slots)
4438                                              slot)
4439                           collect `(:value ,slot-def ,(inspector-princ (swank-mop:slot-definition-name slot-def)))
4440                           collect " = "
4441                           if (slot-boundp-using-class-for-inspector class object slot)
4442                           collect `(:value ,(slot-value-using-class-for-inspector
4443                                              (class-of object) object slot))
4444                           else
4445                           collect "#<unbound>"
4446                           collect '(:newline)))))
4447    
4448  (defmethod inspect-for-emacs ((gf standard-generic-function) inspector)  (defmethod inspect-for-emacs ((gf standard-generic-function) inspector)
   (declare (ignore inspector))  
4449    (flet ((lv (label value) (label-value-line label value)))    (flet ((lv (label value) (label-value-line label value)))
4450      (values      (values
4451       "A generic function."       "A generic function."
# Line 4457  See `methods-by-applicability'.") Line 4468  See `methods-by-applicability'.")
4468                              (remove-method gf m))))                              (remove-method gf m))))
4469                (:newline)))                (:newline)))
4470        `((:newline))        `((:newline))
4471        (all-slots-for-inspector gf)))))        (all-slots-for-inspector gf inspector)))))
4472    
4473  (defmethod inspect-for-emacs ((method standard-method) inspector)  (defmethod inspect-for-emacs ((method standard-method) inspector)
   (declare (ignore inspector))  
4474    (values "A method."    (values "A method."
4475            `("Method defined on the generic function "            `("Method defined on the generic function "
4476              (:value ,(swank-mop:method-generic-function method)              (:value ,(swank-mop:method-generic-function method)
# Line 4478  See `methods-by-applicability'.") Line 4488  See `methods-by-applicability'.")
4488              (:newline)              (:newline)
4489              "Method function: " (:value ,(swank-mop:method-function method))              "Method function: " (:value ,(swank-mop:method-function method))
4490              (:newline)              (:newline)
4491              ,@(all-slots-for-inspector method))))              ,@(all-slots-for-inspector method inspector))))
4492    
4493  (defmethod inspect-for-emacs ((class standard-class) inspector)  (defmethod inspect-for-emacs ((class standard-class) inspector)
   (declare (ignore inspector))  
4494    (values "A class."    (values "A class."
4495            `("Name: " (:value ,(class-name class))            `("Name: " (:value ,(class-name class))
4496              (:newline)              (:newline)
# Line 4538  See `methods-by-applicability'.") Line 4547  See `methods-by-applicability'.")
4547                                 `(:value ,(swank-mop:class-prototype class))                                 `(:value ,(swank-mop:class-prototype class))
4548                                 '"#<N/A (class not finalized)>")                                 '"#<N/A (class not finalized)>")
4549              (:newline)              (:newline)
4550              ,@(all-slots-for-inspector class))))              ,@(all-slots-for-inspector class inspector))))
4551    
4552  (defmethod inspect-for-emacs ((slot swank-mop:standard-slot-definition) inspector)  (defmethod inspect-for-emacs ((slot swank-mop:standard-slot-definition) inspector)
4553    (declare (ignore inspector))    (values "A slot."
   (values "A slot."  
4554            `("Name: " (:value ,(swank-mop:slot-definition-name slot))            `("Name: " (:value ,(swank-mop:slot-definition-name slot))
4555              (:newline)              (:newline)
4556              ,@(when (swank-mop:slot-definition-documentation slot)              ,@(when (swank-mop:slot-definition-documentation slot)
# Line 4555  See `methods-by-applicability'.") Line 4563  See `methods-by-applicability'.")
4563                               "#<unspecified>") (:newline)                               "#<unspecified>") (:newline)
4564              "Init function: " (:value ,(swank-mop:slot-definition-initfunction slot))              "Init function: " (:value ,(swank-mop:slot-definition-initfunction slot))
4565              (:newline)              (:newline)
4566              ,@(all-slots-for-inspector slot))))              ,@(all-slots-for-inspector slot inspector))))
4567    
4568  (defmethod inspect-for-emacs ((package package) inspector)  (defmethod inspect-for-emacs ((package package) inspector)
4569    (declare (ignore inspector))    (declare (ignore inspector))

Legend:
Removed from v.1.414  
changed lines
  Added in v.1.415

  ViewVC Help
Powered by ViewVC 1.1.5