[slime-cvs] CVS slime

[heller]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv5878

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (with-buffer-syntax): Take package as argument.
(defslimefun): Derive the package for exporting from the symbol.

--- /project/slime/cvsroot/slime/ChangeLog	2008/08/12 12:56:57	1.1444
+++ /project/slime/cvsroot/slime/ChangeLog	2008/08/12 12:57:02	1.1445
@@ -1,5 +1,10 @@
 2008-08-12  Helmut Eller  <heller at common-lisp.net>
 
+	* swank.lisp (with-buffer-syntax): Take package as argument.
+	(defslimefun): Derive the package for exporting from the symbol.
+
+2008-08-12  Helmut Eller  <heller at common-lisp.net>
+
 	Let SIGINT create a synthetic event.
 
 	* swank.lisp (install-fd-handler,simple-serve-requests): Dispatch
--- /project/slime/cvsroot/slime/swank.lisp	2008/08/12 12:56:57	1.567
+++ /project/slime/cvsroot/slime/swank.lisp	2008/08/12 12:57:02	1.568
@@ -142,7 +142,7 @@
      (defun ,name ,arglist , at rest)
      ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
      (eval-when (:compile-toplevel :load-toplevel :execute)
-       (export ',name :swank))))
+       (export ',name (symbol-package ',name)))))
 
 (defun missing-arg ()
   "A function that the compiler knows will never to return a value.
@@ -1601,16 +1601,17 @@
 (define-special *buffer-readtable*
     "Readtable associated with the current buffer")
 
-(defmacro with-buffer-syntax ((&rest _) &body body)
+(defmacro with-buffer-syntax ((&optional package) &body body)
   "Execute BODY with appropriate *package* and *readtable* bindings.
 
 This should be used for code that is conceptionally executed in an
 Emacs buffer."
-  (destructuring-bind () _
-    `(call-with-buffer-syntax (lambda () , at body))))
+  `(call-with-buffer-syntax ,package (lambda () , at body)))
 
-(defun call-with-buffer-syntax (fun)
-  (let ((*package* *buffer-package*))
+(defun call-with-buffer-syntax (package fun)
+  (let ((*package* (if package 
+                       (guess-buffer-package package) 
+                       *buffer-package*)))
     ;; Don't shadow *readtable* unnecessarily because that prevents
     ;; the user from assigning to it.
     (if (eq *readtable* *buffer-readtable*)
@@ -1637,6 +1638,12 @@
     (let ((*read-suppress* nil))
       (read-from-string string))))
 
+(defun parse-string (string package)
+  "Read STRING in PACKAGE."
+  (with-buffer-syntax (package)
+    (let ((*read-suppress* nil))
+      (read-from-string string))))
+
 ;; FIXME: deal with #\| etc.  hard to do portably.
 (defun tokenize-symbol (string)
   "STRING is interpreted as the string representation of a symbol