[slime-cvs] CVS slime
CVS User heller
heller at common-lisp.net
Thu Jan 8 10:33:44 UTC 2009
Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv17635
Modified Files:
ChangeLog slime.el swank-abcl.lisp swank-allegro.lisp
swank-backend.lisp swank-clisp.lisp swank-cmucl.lisp
swank-corman.lisp swank-ecl.lisp swank-lispworks.lisp
swank-openmcl.lisp swank-sbcl.lisp swank-scl.lisp swank.lisp
Log Message:
* swank-backend.lisp (swank-compile-string): Pass the
buffer-file-name to Lisp, not only the directory.
Update callers accordingly
--- /project/slime/cvsroot/slime/ChangeLog 2009/01/08 10:33:30 1.1652
+++ /project/slime/cvsroot/slime/ChangeLog 2009/01/08 10:33:43 1.1653
@@ -1,5 +1,11 @@
2009-01-08 Helmut Eller <heller at common-lisp.net>
+ * swank-backend.lisp (swank-compile-string): Pass the
+ buffer-file-name to Lisp, not only the directory.
+ Update callers accordingly.
+
+2009-01-08 Helmut Eller <heller at common-lisp.net>
+
* slime.el (slime-popup-restore-data): Renamed from
slime-popup-buffer-restore-info.
(slime-popup-buffer-saved-fingerprint)
--- /project/slime/cvsroot/slime/slime.el 2009/01/08 10:33:30 1.1111
+++ /project/slime/cvsroot/slime/slime.el 2009/01/08 10:33:43 1.1112
@@ -2680,7 +2680,7 @@
,string
,(buffer-name)
,start-offset
- ,(if (buffer-file-name) (file-name-directory (buffer-file-name)))
+ ,(if (buffer-file-name) (slime-to-lisp-filename (buffer-file-name)))
',slime-compilation-policy)
#'slime-compilation-finished))
--- /project/slime/cvsroot/slime/swank-abcl.lisp 2008/12/30 18:57:54 1.61
+++ /project/slime/cvsroot/slime/swank-abcl.lisp 2009/01/08 10:33:43 1.62
@@ -340,9 +340,9 @@
(and load-p
(not (load fn))))))))))
-(defimplementation swank-compile-string (string &key buffer position directory
- policy)
- (declare (ignore directory policy))
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (declare (ignore filename policy))
(let ((jvm::*resignal-compiler-warnings* t)
(*abcl-signaled-conditions* nil))
(handler-bind ((warning #'handle-compiler-warning))
--- /project/slime/cvsroot/slime/swank-allegro.lisp 2008/12/30 18:57:54 1.120
+++ /project/slime/cvsroot/slime/swank-allegro.lisp 2009/01/08 10:33:43 1.121
@@ -315,8 +315,8 @@
(delete-file binary-filename))
(not failure?)))))
-(defimplementation swank-compile-string (string &key buffer position directory
- policy)
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
(declare (ignore policy))
;; We store the source buffer in excl::*source-pathname* as a string
;; of the form <buffername>;<start-offset>. Quite ugly encoding, but
@@ -326,14 +326,14 @@
(*buffer-start-position* position)
(*buffer-string* string)
(*default-pathname-defaults*
- (if directory (merge-pathnames (pathname directory))
+ (if directory (merge-pathnames (pathname filename))
*default-pathname-defaults*)))
(compile-from-temp-file
(format nil "~S ~S~%~A"
`(in-package ,(package-name *package*))
`(eval-when (:compile-toplevel :load-toplevel)
- (setq excl::*source-pathname*
- ',(format nil "~A;~D" buffer position)))
+ (setq excl::*source-pathname*
+ ',(or filename (format nil "~A;~D" buffer position))))
string)))))
;;;; Definition Finding
--- /project/slime/cvsroot/slime/swank-backend.lisp 2008/12/31 11:25:03 1.166
+++ /project/slime/cvsroot/slime/swank-backend.lisp 2009/01/08 10:33:43 1.167
@@ -370,7 +370,7 @@
(declare (ignore ignore))
`(call-with-compilation-hooks (lambda () (progn , at body))))
-(definterface swank-compile-string (string &key buffer position directory
+(definterface swank-compile-string (string &key buffer position filename
policy)
"Compile source from STRING.
During compilation, compiler conditions must be trapped and
@@ -381,11 +381,11 @@
Additionally, if POSITION is supplied, it must be added to source
positions reported in compiler conditions.
-If DIRECTORY is specified it may be used by certain implementations to
+If FILENAME is specified it may be used by certain implementations to
rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
source information.
-If DEBUG is supplied, and non-NIL, it may be used by certain
+If POLICY is supplied, and non-NIL, it may be used by certain
implementations to compile with a debug optimization quality of its
value.
--- /project/slime/cvsroot/slime/swank-clisp.lisp 2009/01/03 21:13:00 1.86
+++ /project/slime/cvsroot/slime/swank-clisp.lisp 2009/01/08 10:33:43 1.87
@@ -635,9 +635,9 @@
(and load-p
(not (load fasl-file)))))))))
-(defimplementation swank-compile-string (string &key buffer position directory
+(defimplementation swank-compile-string (string &key buffer position filename
policy)
- (declare (ignore directory policy))
+ (declare (ignore filename policy))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-offset* position))
--- /project/slime/cvsroot/slime/swank-cmucl.lisp 2009/01/08 06:45:37 1.208
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2009/01/08 10:33:44 1.209
@@ -394,9 +394,9 @@
(source-cache-get filename (file-write-date filename))
(not (load output-file)))))))))
-(defimplementation swank-compile-string (string &key buffer position directory
- policy)
- (declare (ignore directory policy))
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (declare (ignore filename policy))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-start-position* position)
--- /project/slime/cvsroot/slime/swank-corman.lisp 2008/12/30 18:57:54 1.21
+++ /project/slime/cvsroot/slime/swank-corman.lisp 2009/01/08 10:33:44 1.22
@@ -371,9 +371,9 @@
(values output-file warnings?
(or failure? (and load-p (load output-file))))))))
-(defimplementation swank-compile-string (string &key buffer position directory
- policy)
- (declare (ignore directory policy))
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (declare (ignore filename policy))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-position* position)
--- /project/slime/cvsroot/slime/swank-ecl.lisp 2008/12/30 18:57:54 1.36
+++ /project/slime/cvsroot/slime/swank-ecl.lisp 2009/01/08 10:33:44 1.37
@@ -145,9 +145,9 @@
(let ((*buffer-name* nil))
(compile-file *compile-filename* :load t))))
-(defimplementation swank-compile-string (string &key buffer position directory
- policy)
- (declare (ignore directory policy))
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (declare (ignore filename policy))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-start-position* position)
--- /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/12/31 11:25:03 1.125
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp 2009/01/08 10:33:44 1.126
@@ -628,9 +628,9 @@
nil)))
htab))
-(defimplementation swank-compile-string (string &key buffer position directory
- policy)
- (declare (ignore directory policy))
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
+ (declare (ignore filename policy))
(assert buffer)
(assert position)
(let* ((location (list :emacs-buffer buffer position string))
--- /project/slime/cvsroot/slime/swank-openmcl.lisp 2009/01/01 14:48:22 1.152
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp 2009/01/08 10:33:44 1.153
@@ -368,40 +368,38 @@
(mapcan 'who-specializes (ccl::%class-direct-subclasses class)))
:test 'equal))
-(defimplementation swank-compile-string (string &key buffer position directory
+(defimplementation swank-compile-string (string &key buffer position filename
policy)
(declare (ignore policy))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-offset* position)
- (filename (temp-file-name)))
+ (temp-file-name (temp-file-name)))
(unwind-protect
- (with-open-file (s filename :direction :output :if-exists :error)
- (write-string string s))
- (let ((binary-filename (compile-temp-file
- filename directory buffer position)))
- (delete-file binary-filename)))
- (delete-file filename))))
+ (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 note-temp-file (filename directory buffer)
- (cond (directory
- (format nil "~a/~a" directory buffer))
- (t
- (setf (gethash filename *temp-file-map*) buffer)
- filename)))
-
-(defun compile-temp-file (filename dir buffer offset)
+(defun compile-temp-file (temp-file-name buffer-file-name buffer-name offset)
(if (fboundp 'ccl::function-source-note)
- (compile-file filename
+ (compile-file temp-file-name
:load t
- :compile-file-original-truename (note-temp-file filename
- dir
- buffer)
+ :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 filename :load t)))
+ (compile-file temp-file-name :load t)))
;;; Profiling (alanr: lifted from swank-clisp)
--- /project/slime/cvsroot/slime/swank-sbcl.lisp 2009/01/05 11:19:09 1.230
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2009/01/08 10:33:44 1.231
@@ -525,12 +525,12 @@
(loop for (qual . value) in policy
do (sb-ext:restrict-compiler-policy qual value)))
-(defimplementation swank-compile-string (string &key buffer position directory
- policy)
+(defimplementation swank-compile-string (string &key buffer position filename
+ policy)
(let ((*buffer-name* buffer)
(*buffer-offset* position)
(*buffer-substring* string)
- (filename (temp-file-name))
+ (temp-file-name (temp-file-name))
(saved-policy (get-compiler-policy '((debug . 0) (speed . 0)))))
(when policy
(set-compiler-policy policy))
@@ -540,11 +540,11 @@
(with-compilation-hooks ()
(with-compilation-unit
(:source-plist (list :emacs-buffer buffer
- :emacs-directory directory
+ :emacs-filename filename
:emacs-string string
:emacs-position position))
- (funcall cont (compile-file filename))))))
- (with-open-file (s filename :direction :output :if-exists :error)
+ (funcall cont (compile-file temp-file-name))))))
+ (with-open-file (s temp-file-name :direction :output :if-exists :error)
(write-string string s))
(unwind-protect
(if *trap-load-time-warnings*
@@ -552,8 +552,8 @@
(load-it (compile-it #'identity)))
(ignore-errors
(set-compiler-policy saved-policy)
- (delete-file filename)
- (delete-file (compile-file-pathname filename)))))))
+ (delete-file temp-file-name)
+ (delete-file (compile-file-pathname temp-file-name)))))))
;;;; Definitions
--- /project/slime/cvsroot/slime/swank-scl.lisp 2008/12/30 18:57:54 1.30
+++ /project/slime/cvsroot/slime/swank-scl.lisp 2009/01/08 10:33:44 1.31
@@ -451,9 +451,9 @@
(source-cache-get filename (file-write-date filename))
(not (load output-file)))))))))
-(defimplementation swank-compile-string (string &key buffer position directory
+(defimplementation swank-compile-string (string &key buffer position filename
policy)
- (declare (ignore directory policy))
+ (declare (ignore filename policy))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-start-position* position)
--- /project/slime/cvsroot/slime/swank.lisp 2009/01/08 06:45:45 1.626
+++ /project/slime/cvsroot/slime/swank.lisp 2009/01/08 10:33:44 1.627
@@ -2736,7 +2736,7 @@
(declare (ignore output-pathname warnings?))
(not failure?)))))))
-(defslimefun compile-string-for-emacs (string buffer position directory policy)
+(defslimefun compile-string-for-emacs (string buffer position filename policy)
"Compile STRING (exerpted from BUFFER at POSITION).
Record compiler notes signalled as `compiler-condition's."
(with-buffer-syntax ()
@@ -2746,13 +2746,13 @@
(swank-compile-string string
:buffer buffer
:position position
- :directory directory
+ :filename filename
:policy policy))))))
(defslimefun compile-multiple-strings-for-emacs (strings policy)
"Compile STRINGS (exerpted from BUFFER at POSITION).
Record compiler notes signalled as `compiler-condition's."
- (loop for (string buffer package position directory) in strings collect
+ (loop for (string buffer package position filename) in strings collect
(collect-notes
(lambda ()
(with-buffer-syntax (package)
@@ -2760,7 +2760,7 @@
(swank-compile-string string
:buffer buffer
:position position
- :directory directory
+ :filename filename
:policy policy)))))))
(defun file-newer-p (new-file old-file)
More information about the slime-cvs
mailing list