[slime-devel] Better solution to redefinition warnings in Allegro

[Peter Seibel]

Since my last attempt (a couple weeks ago) was totally bogus I tried
again. Here's my latest attempt. I wanted to check whether there was
anything about this version that was as busted as my previous attempt
before I made the corresponding changes to the other backends.

The basic idea is that we pass a new argument to swank-compile-string
containing the directory of the file of the buffer from which we are
compiling (when there is one). In the Allegro backend we bind
*DEFAULT-PATHNAME-DEFAULTS* to this directory so that the source
recording mechanism thinks the file it is recording is in that
directory. Then you can add something like this to one's .swank.lisp
to make Allegro ignore the :<position> part of the recorded location.

  #+allegro
  (setf excl::*redefinition-pathname-comparison-hook*
        (list #'(lambda (old new obj type)
                  (declare (ignore obj type))
                  (cond
                    ((string= (namestring old) 
                              (let ((str (namestring new)))
                                (subseq str 0 (position #\: str :from-end t)))))))))

Here's the patch; please let me know what you think.

-Peter


Index: slime.el
===================================================================
RCS file: /project/slime/cvsroot/slime/slime.el,v
retrieving revision 1.392
diff -u -r1.392 slime.el
--- slime.el	16 Aug 2004 21:41:35 -0000	1.392
+++ slime.el	17 Aug 2004 15:32:21 -0000
@@ -3147,7 +3147,7 @@
 
 (defun slime-compile-string (string start-offset)
   (slime-eval-async 
-   `(swank:compile-string-for-emacs ,string ,(buffer-name) ,start-offset)
+   `(swank:compile-string-for-emacs ,string ,(buffer-name) ,start-offset ,(if (buffer-file-name) (file-name-directory (buffer-file-name))))
    (slime-compilation-finished-continuation)))
 
 (defvar slime-hide-style-warning-count-if-zero t)
@@ -7157,7 +7157,7 @@
       ("swank::emacs-connected"
        "(swank::emacs-connected stream)")
       ("swank::compile-string-for-emacs"
-       "(swank::compile-string-for-emacs string buffer position)")
+       "(swank::compile-string-for-emacs string buffer position directory)")
       ("swank::connection.socket-io"
        "(swank::connection.socket-io \\(struct\\(ure\\)?\\|object\\|instance\\))")
       ("cl:lisp-implementation-type"
Index: swank-allegro.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-allegro.lisp,v
retrieving revision 1.49
diff -u -r1.49 swank-allegro.lisp
--- swank-allegro.lisp	4 Aug 2004 17:17:55 -0000	1.49
+++ swank-allegro.lisp	17 Aug 2004 15:32:21 -0000
@@ -239,14 +239,15 @@
          (when binary-filename
            (delete-file binary-filename))))))
 
-(defimplementation swank-compile-string (string &key buffer position)
+(defimplementation swank-compile-string (string &key buffer position (directory *default-pathname-defaults*))
   ;; We store the source buffer in excl::*source-pathname* as a string
   ;; of the form <buffername>:<start-offset>.  Quite ugly encoding, but
   ;; the fasl file is corrupted if we use some other datatype.
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-start-position* position)
-          (*buffer-string* string))
+          (*buffer-string* string)
+          (*default-pathname-defaults* (merge-pathnames (pathname directory))))
       (compile-from-temp-file
        (format nil "~S ~S~%~A" 
                `(in-package ,(package-name *package*))
Index: swank-backend.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-backend.lisp,v
retrieving revision 1.63
diff -u -r1.63 swank-backend.lisp
--- swank-backend.lisp	30 Jul 2004 21:44:05 -0000	1.63
+++ swank-backend.lisp	17 Aug 2004 15:32:21 -0000
@@ -191,14 +191,17 @@
   (declare (ignore ignore))
   `(call-with-compilation-hooks (lambda () (progn , at body))))
 
-(definterface swank-compile-string (string &key buffer position)
+(definterface swank-compile-string (string &key buffer position directory)
   "Compile source from STRING.  During compilation, compiler
 conditions must be trapped and resignalled as COMPILER-CONDITIONs.
 
 If supplied, BUFFER and POSITION specify the source location in Emacs.
 
 Additionally, if POSITION is supplied, it must be added to source
-positions reported in compiler conditions.")
+positions reported in compiler conditions.
+
+And if DIRECTORY is specified it is bound as the value of
+*DEFAULT-PATHNAME-DEFAULTS*.")
 
 (definterface operate-on-system (system-name operation-name &rest keyword-args)
   "Perform OPERATION-NAME on SYSTEM-NAME using ASDF.
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.222
diff -u -r1.222 swank.lisp
--- swank.lisp	13 Aug 2004 16:14:13 -0000	1.222
+++ swank.lisp	17 Aug 2004 15:32:22 -0000
@@ -1505,13 +1505,13 @@
 Record compiler notes signalled as `compiler-condition's."
   (swank-compiler (lambda () (swank-compile-file filename load-p))))
 
-(defslimefun compile-string-for-emacs (string buffer position)
+(defslimefun compile-string-for-emacs (string buffer position directory)
   "Compile STRING (exerpted from BUFFER at POSITION).
 Record compiler notes signalled as `compiler-condition's."
   (with-buffer-syntax ()
     (swank-compiler
      (lambda () 
-       (swank-compile-string string :buffer buffer :position position)))))
+       (swank-compile-string string :buffer buffer :position position :directory directory)))))
 
 (defslimefun operate-on-system-for-emacs (system-name operation &rest keywords)
   "Compile and load SYSTEM using ASDF.



-- 
Peter Seibel                                      peter at javamonkey.com

         Lisp is the red pill. -- John Fraser, comp.lang.lisp