[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