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

Diff of /slime/swank-backend.lisp

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

revision 1.217 by heller, Sat Apr 7 10:23:38 2012 UTC revision 1.218 by sboukarev, Thu May 3 14:12:22 2012 UTC
# Line 239  EXCEPT is a list of symbol names which s Line 239  EXCEPT is a list of symbol names which s
239    
240  (defmacro with-struct ((conc-name &rest names) obj &body body)  (defmacro with-struct ((conc-name &rest names) obj &body body)
241    "Like with-slots but works only for structs."    "Like with-slots but works only for structs."
242    (flet ((reader (slot) (intern (concatenate 'string    (flet ((reader (slot)
243                                               (symbol-name conc-name)             ;; Use read-from-string instead of intern so that
244                                               (symbol-name slot))             ;; conc-name can be a string such as ext:struct- and not
245                                  (symbol-package conc-name))))             ;; cause errors and not force interning ext::struct-
246               (read-from-string
247                (concatenate 'string (string conc-name) (string slot)))))
248      (let ((tmp (gensym "OO-")))      (let ((tmp (gensym "OO-")))
249      ` (let ((,tmp ,obj))        ` (let ((,tmp ,obj))
250          (symbol-macrolet            (symbol-macrolet
251              ,(loop for name in names collect                ,(loop for name in names collect
252                     (typecase name                       (typecase name
253                       (symbol `(,name (,(reader name) ,tmp)))                         (symbol `(,name (,(reader name) ,tmp)))
254                       (cons `(,(first name) (,(reader (second name)) ,tmp)))                         (cons `(,(first name) (,(reader (second name)) ,tmp)))
255                       (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))                         (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
256            ,@body)))))              ,@body)))))
257    
258  (defmacro when-let ((var value) &body body)  (defmacro when-let ((var value) &body body)
259    `(let ((,var ,value))    `(let ((,var ,value))

Legend:
Removed from v.1.217  
changed lines
  Added in v.1.218

  ViewVC Help
Powered by ViewVC 1.1.5