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

Diff of /slime/swank.lisp

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

revision 1.503 by heller, Tue Aug 28 13:53:02 2007 UTC revision 1.504 by trittweiler, Tue Aug 28 20:44:41 2007 UTC
# Line 1678  secondary return value." Line 1678  secondary return value."
1678      (with-buffer-syntax ()      (with-buffer-syntax ()
1679        (call-with-ignored-reader-errors        (call-with-ignored-reader-errors
1680         #'(lambda ()         #'(lambda ()
1681             (let ((result) (newly-interned-symbols))             (let ((result) (newly-interned-symbols) (ok))
1682               (dolist (element spec)               (unwind-protect
1683                 (etypecase element                    (progn
1684                   (string                      (dolist (element spec)
1685                    (multiple-value-bind (symbol found? symbol-name package)                        (etypecase element
1686                        (parse-symbol element)                          (string
1687                      (if found?                           (multiple-value-bind (symbol found? symbol-name package)
1688                          (push symbol result)                               (parse-symbol element)
1689                          (let ((sexp (read-from-string element)))                             (if found?
1690                            (when (symbolp sexp)                                 (push symbol result)
1691                              (push sexp newly-interned-symbols)                                 (let ((sexp (read-from-string element)))
1692                              ;; assert that PARSE-SYMBOL didn't parse incorrectly.                                   (when (symbolp sexp)
1693                              (assert (and (equal symbol-name (symbol-name sexp))                                     (push sexp newly-interned-symbols)
1694                                           (eq package (symbol-package sexp)))))                                     ;; assert that PARSE-SYMBOL didn't parse incorrectly.
1695                            (push sexp result)))))                                     (assert (and (equal symbol-name (symbol-name sexp))
1696                   (cons                                                  (eq package (symbol-package sexp)))))
1697                    (multiple-value-bind (read-spec interned-symbols)                                   (push sexp result)))))
1698                        (read-form-spec element)                          (cons
1699                      (push read-spec result)                           (multiple-value-bind (read-spec interned-symbols)
1700                      (setf newly-interned-symbols                               (read-form-spec element)
1701                            (append interned-symbols                             (push read-spec result)
1702                                    newly-interned-symbols))))))                             (setf newly-interned-symbols
1703                                     (append interned-symbols
1704                                             newly-interned-symbols))))))
1705                        (setq ok t))
1706                   (mapc #'unintern newly-interned-symbols))
1707               (values (nreverse result)               (values (nreverse result)
1708                       (nreverse newly-interned-symbols))))))))                       (nreverse newly-interned-symbols))))))))
1709    

Legend:
Removed from v.1.503  
changed lines
  Added in v.1.504

  ViewVC Help
Powered by ViewVC 1.1.5