[slime-cvs] CVS update: slime/swank.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv9374

Modified Files:
	swank.lisp 
Log Message:
(changelog-date): Use *compile-file-truename* instead of
*compile-file-pathname*.

(with-I/O-lock, with-a-connection): The usual CLISP fixes.
Date: Fri Jan 16 02:26:13 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.99 slime/swank.lisp:1.100
--- slime/swank.lisp:1.99	Fri Jan 16 01:50:52 2004
+++ slime/swank.lisp	Fri Jan 16 02:26:13 2004
@@ -157,7 +157,8 @@
 
 ;;;; Helper macros
 
-(defmacro with-I/O-lock (() &body body)
+(defmacro with-I/O-lock ((&rest ignore) &body body)
+  (declare (ignore ignore))
   `(call-with-lock-held *write-lock* (lambda () , at body)))
 
 (defmacro with-io-redirection ((&optional (connection '(current-connection)))
@@ -270,10 +271,11 @@
   "Return the datestring of the latest ChangeLog entry.  The date is
 determined at compile time."
   (macrolet ((date ()
-               (let* ((dir (pathname-directory *compile-file-pathname*))
-                      (changelog (make-pathname :name "ChangeLog" :directory dir
-                                                :host (pathname-host
-                                                       *compile-file-pathname*)))
+               (let* ((here (or *compile-file-truename* *load-truename*))
+		      (changelog (make-pathname 
+				  :name "ChangeLog" 
+				  :directory (pathname-directory here)
+				  :host (pathname-host here)))
 		      (date (with-open-file (file changelog :direction :input)
 			      (string (read file)))))
 		 `(quote ,date))))
@@ -318,12 +320,13 @@
 (defun current-socket-io ()
   (connection.socket-io (current-connection)))
 
-(defmacro with-a-connection (() &body body)
+(defmacro with-a-connection ((&rest ignore) &body body)
   "Execute BODY with a connection.
 If no connection is currently available then a new one is
 temporarily created for the extent of the execution.
 
 Thus the BODY forms can call READ-FROM-EMACS and SEND-TO-EMACS."
+  (declare (ignore ignore))
   `(if (current-connection)
        (progn , at body)
        (call-with-aux-connection (lambda () , at body))))