[slime-cvs] CVS slime

[trittweiler]

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

Modified Files:
	swank.lisp swank-sbcl.lisp swank-backend.lisp 
Log Message:

	Compiling a file `let*.lisp' on SBCL via C-c C-k resulted in an
	error, because it parsed the asterisk to a wild pathname. Fix
	that.

	* swank-backend.lisp (definterface parse-emacs-filename): New.
	PARSE-NAMESTRING by default.

	* swank-sbcl.lisp (defimplementation parse-emacs-filename): Use
	SB-EXT:PARSE-NATIVE-NAMESTRING.

	* swank.lisp (compile-file-for-emacs): Use PARSE-EMACS-FILENAME.
	(compile-file-if-needed): Ditto.
	(load-file): Ditto.
	(swank-require): Ditto.


--- /project/slime/cvsroot/slime/swank.lisp	2008/08/17 23:01:19	1.571
+++ /project/slime/cvsroot/slime/swank.lisp	2008/08/22 14:28:40	1.572
@@ -2377,9 +2377,10 @@
       (let ((*compile-print* nil))
         (swank-compiler 
          (lambda ()
-           (swank-compile-file filename load-p
-                               (or (guess-external-format filename)
-                                   :default))))))))
+           (let ((pathname (parse-emacs-filename filename)))
+             (swank-compile-file pathname load-p
+                                 (or (guess-external-format pathname)
+                                     :default)))))))))
 
 (defslimefun compile-string-for-emacs (string buffer position directory debug)
   "Compile STRING (exerpted from BUFFER at POSITION).
@@ -2404,17 +2405,18 @@
         (file-newer-p source-file fasl-file))))
 
 (defslimefun compile-file-if-needed (filename loadp)
-  (cond ((requires-compile-p filename)
-         (compile-file-for-emacs filename loadp))
-        (loadp
-         (load (compile-file-pathname filename))
-         nil)))
+  (let ((pathname (parse-emacs-filename filename)))
+    (cond ((requires-compile-p pathname)
+           (compile-file-for-emacs pathname loadp))
+          (loadp
+           (load (compile-file-pathname pathname))
+           nil))))
 
 
 ;;;; Loading
 
 (defslimefun load-file (filename)
-  (to-string (load filename)))
+  (to-string (load (parse-emacs-filename filename))))
 
 
 ;;;;; swank-require
@@ -2423,7 +2425,9 @@
   "Load the module MODULE."
   (dolist (module (if (listp modules) modules (list modules)))
     (unless (member (string module) *modules* :test #'string=)
-      (require module (or filename (module-filename module)))))
+      (require module (if filename
+                          (parse-emacs-filename filename)
+                          (module-filename module)))))
   *modules*)
 
 (defvar *find-module* 'find-module
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/08/17 08:31:22	1.215
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/08/22 14:28:41	1.216
@@ -173,6 +173,12 @@
     (:euc-jp "euc-jp" "euc-jp-unix")
     (:us-ascii "us-ascii" "us-ascii-unix")))
 
+;; C.f. R.M.Kreuter in <20536.1219412774 at progn.net> on sbcl-general, 2008-08-22.
+(defvar *physical-pathname-host* (pathname-host (user-homedir-pathname)))
+
+(defimplementation parse-emacs-filename (filename)
+  (sb-ext:parse-native-namestring filename *physical-pathname-host*))
+
 (defimplementation find-external-format (coding-system)
   (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
                   *external-format-to-coding-system*)))
@@ -429,14 +435,14 @@
 
 (defvar *trap-load-time-warnings* nil)
 
-(defimplementation swank-compile-file (filename load-p external-format)
+(defimplementation swank-compile-file (pathname load-p external-format)
   (handler-case
       (let ((output-file (with-compilation-hooks ()
-                           (compile-file filename 
+                           (compile-file pathname 
                                          :external-format external-format))))
         (when output-file
           ;; Cache the latest source file for definition-finding.
-          (source-cache-get filename (file-write-date filename))
+          (source-cache-get pathname (file-write-date pathname))
           (when load-p
             (load output-file))))
     (sb-c:fatal-compiler-error () nil)))
--- /project/slime/cvsroot/slime/swank-backend.lisp	2008/08/12 17:54:43	1.145
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2008/08/22 14:28:41	1.146
@@ -369,8 +369,8 @@
 Should return T on successfull compilation, NIL otherwise.
 ")
 
-(definterface swank-compile-file (filename load-p external-format)
-   "Compile FILENAME signalling COMPILE-CONDITIONs.
+(definterface swank-compile-file (pathname load-p external-format)
+   "Compile PATHNAME signalling COMPILE-CONDITIONs.
 If LOAD-P is true, load the file after compilation.
 EXTERNAL-FORMAT is a value returned by find-external-format or
 :default.
@@ -407,6 +407,11 @@
    (location :initarg :location
              :accessor location)))
 
+(definterface parse-emacs-filename (filename)
+  "Return a PATHNAME for FILENAME. A filename in Emacs may for example
+contain asterisks which should not be translated to wildcards."
+  (parse-namestring filename))
+
 (definterface find-external-format (coding-system)
   "Return a \"external file format designator\" for CODING-SYSTEM.
 CODING-SYSTEM is Emacs-style coding system name (a string),
@@ -415,11 +420,11 @@
       :default
       nil))
 
-(definterface guess-external-format (filename)
-  "Detect the external format for the file with name FILENAME.
+(definterface guess-external-format (pathname)
+  "Detect the external format for the file with name pathname.
 Return nil if the file contains no special markers."
   ;; Look for a Emacs-style -*- coding: ... -*- or Local Variable: section.
-  (with-open-file (s filename :if-does-not-exist nil
+  (with-open-file (s pathname :if-does-not-exist nil
                      :external-format (or (find-external-format "latin-1-unix")
                                           :default))
     (if s 
@@ -992,7 +997,7 @@
   0)
 
 (definterface all-threads ()
-  "Return a list of all threads.")
+  "Return a fresh list of all threads.")
 
 (definterface thread-alive-p (thread)
   "Test if THREAD is termintated."