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

Diff of /slime/swank.lisp

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

revision 1.441 by alendvai, Sun Dec 24 13:38:36 2006 UTC revision 1.442 by alendvai, Sun Dec 24 13:40:05 2006 UTC
# Line 4446  See `methods-by-applicability'.") Line 4446  See `methods-by-applicability'.")
4446    
4447  (defgeneric inspect-slot-for-emacs (class object slot)  (defgeneric inspect-slot-for-emacs (class object slot)
4448    (:method (class object slot)    (:method (class object slot)
4449             (let ((slot-name (swank-mop:slot-definition-name slot)))             (let ((slot-name (swank-mop:slot-definition-name slot))
4450               `(,@(if (swank-mop:slot-boundp-using-class class object slot)                   (boundp (swank-mop:slot-boundp-using-class class object slot)))
4451                       `((:value ,(swank-mop:slot-value-using-class class object slot))               `(,@(if boundp
4452                         " " (:action "[make unbound]"                       `((:value ,(swank-mop:slot-value-using-class class object slot)))
4453                              ,(lambda () (swank-mop:slot-makunbound-using-class class object slot))))                       `("#<unbound>"))
4454                       '("#<unbound>"))                 " "
4455                 " " (:action "[set value]"                 (:action "[set value]"
4456                      ,(lambda () (with-simple-restart                  ,(lambda () (with-simple-restart
4457                                      (abort "Abort setting slot ~S" slot-name)                                  (abort "Abort setting slot ~S" slot-name)
4458                                    (let ((value-string (eval-in-emacs                                (let ((value-string (eval-in-emacs
4459                                                         `(condition-case c                                                     `(condition-case c
4460                                                           (slime-read-object                                                       (slime-read-object
4461                                                            ,(format nil "Set slot ~S to (evaluated) : " slot-name))                                                        ,(format nil "Set slot ~S to (evaluated) : " slot-name))
4462                                                           (quit nil)))))                                                       (quit nil)))))
4463                                      (when (and value-string                                  (when (and value-string
4464                                                 (not (string= value-string "")))                                             (not (string= value-string "")))
4465                                        (setf (swank-mop:slot-value-using-class class object slot)                                    (setf (swank-mop:slot-value-using-class class object slot)
4466                                              (eval (read-from-string value-string))))))))))))                                          (eval (read-from-string value-string))))))))
4467                   " "
4468                   ,@(when boundp
4469                       `(" " (:action "[make unbound]"
4470                              ,(lambda () (swank-mop:slot-makunbound-using-class class object slot)))))))))
4471    
4472  (defgeneric all-slots-for-inspector (object inspector)  (defgeneric all-slots-for-inspector (object inspector)
4473    (:method ((object standard-object) inspector)    (:method ((object standard-object) inspector)

Legend:
Removed from v.1.441  
changed lines
  Added in v.1.442

  ViewVC Help
Powered by ViewVC 1.1.5