[slime-cvs] CVS slime

CVS User heller heller at common-lisp.net
Sun May 17 13:00:06 UTC 2009


Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv7994

Modified Files:
	ChangeLog swank-openmcl.lisp 
Log Message:
* swank-openmcl.lisp (compile-temp-file): Remove backward
compatibility code.

--- /project/slime/cvsroot/slime/ChangeLog	2009/05/17 08:59:31	1.1759
+++ /project/slime/cvsroot/slime/ChangeLog	2009/05/17 13:00:06	1.1760
@@ -1,5 +1,10 @@
 2009-05-17  Helmut Eller  <heller at common-lisp.net>
 
+	* swank-openmcl.lisp (compile-temp-file): Remove backward
+	compatibility code.
+
+2009-05-17  Helmut Eller  <heller at common-lisp.net>
+
 	More precise compiler-message location.
 
 	* swank-openmcl.lisp (handle-compiler-warning): Use the
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/05/17 08:59:31	1.165
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/05/17 13:00:06	1.166
@@ -205,7 +205,7 @@
 (defimplementation lisp-implementation-type-name ()
   "ccl")
 
-;;; Evaluation
+;;; Arglist
 
 (defimplementation arglist (fname)
   (arglist% fname))
@@ -254,6 +254,42 @@
                   :load load-p
                   :external-format external-format)))
 
+(defun temp-file-name ()
+  "Return a temporary file name to compile strings into."
+  (ccl:%get-cstring (#_tmpnam (ccl:%null-ptr))))
+
+(defimplementation swank-compile-string (string &key buffer position filename
+                                         policy)
+  (declare (ignore policy))
+  (with-compilation-hooks ()
+    (let ((temp-file-name (temp-file-name))
+          (ccl:*save-source-locations* t))
+      (unwind-protect
+           (progn
+             (with-open-file (s temp-file-name :direction :output 
+                                :if-exists :error)
+               (write-string string s))
+             (let ((binary-filename (compile-temp-file
+                                     temp-file-name filename buffer position)))
+               (delete-file binary-filename)))
+        (delete-file temp-file-name)))))
+
+(defvar *temp-file-map* (make-hash-table :test #'equal)
+  "A mapping from tempfile names to Emacs buffer names.")
+
+(defun compile-temp-file (temp-file-name buffer-file-name buffer-name offset)
+  (compile-file temp-file-name
+                :load t
+                :compile-file-original-truename 
+                (or buffer-file-name
+                    (progn 
+                      (setf (gethash temp-file-name *temp-file-map*)
+                            buffer-name)
+                      temp-file-name))
+                :compile-file-original-buffer-offset (1- offset)))
+
+;;; Cross-referencing
+
 (defun xref-locations (relation name &optional (inverse nil))
   (flet ((function-source-location (entry)
            (multiple-value-bind (info name)
@@ -339,41 +375,6 @@
            (mapcan 'who-specializes (ccl::%class-direct-subclasses class)))
    :test 'equal))
 
-(defun temp-file-name ()
-  "Return a temporary file name to compile strings into."
-  (ccl:%get-cstring (#_tmpnam (ccl:%null-ptr))))
-
-(defimplementation swank-compile-string (string &key buffer position filename
-                                         policy)
-  (declare (ignore policy))
-  (with-compilation-hooks ()
-    (let ((temp-file-name (temp-file-name))
-          (ccl:*save-source-locations* t))
-      (unwind-protect
-           (progn
-             (with-open-file (s temp-file-name :direction :output 
-                                :if-exists :error)
-               (write-string string s))
-             (let ((binary-filename (compile-temp-file
-                                     temp-file-name filename buffer position)))
-               (delete-file binary-filename)))
-        (delete-file temp-file-name)))))
-
-(defvar *temp-file-map* (make-hash-table :test #'equal)
-  "A mapping from tempfile names to Emacs buffer names.")
-
-(defun compile-temp-file (temp-file-name buffer-file-name buffer-name offset)
-  (if (fboundp 'ccl::function-source-note)
-      (compile-file temp-file-name
-                    :load t
-                    :compile-file-original-truename 
-                    (or buffer-file-name
-                        (progn 
-                          (setf (gethash temp-file-name *temp-file-map*)
-                                buffer-name)
-                          temp-file-name))
-                    :compile-file-original-buffer-offset (1- offset))
-      (compile-file temp-file-name :load t)))
 
 ;;; Profiling (alanr: lifted from swank-clisp)
 





More information about the slime-cvs mailing list