[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
For C-c C-k, ask before loading possibly broken fasl files.

* slime.el (slime-compilation-result): Add 2 slots: loadp and
faslfile.
(slime-compilation-finished): Use them to load the faslfile.
* swank.lisp (:compilation-result): Add 2 slots. Use keyword
constructor.
(compile-file-for-emacs): Return loadp and faslfile to Emacs.
(collect-notes): Pass loadp and falsfile along.

--- /project/slime/cvsroot/slime/ChangeLog	2010/09/02 17:21:09	1.2136
+++ /project/slime/cvsroot/slime/ChangeLog	2010/09/03 07:25:19	1.2137
@@ -1,3 +1,15 @@
+2010-09-03  Helmut Eller  <heller at common-lisp.net>
+
+	For C-c C-k, ask before loading possibly broken fasl files.
+
+	* slime.el (slime-compilation-result): Add 2 slots: loadp and
+	faslfile.
+	(slime-compilation-finished): Use them to load the faslfile.
+	* swank.lisp (:compilation-result): Add 2 slots. Use keyword
+	constructor.
+	(compile-file-for-emacs): Return loadp and faslfile to Emacs.
+	(collect-notes): Pass loadp and falsfile along.
+
 2010-09-02  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-cmucl.lisp: #-cmu19 -> #+cmu18, cmu18 is allegedly the
--- /project/slime/cvsroot/slime/slime.el	2010/08/22 10:51:11	1.1336
+++ /project/slime/cvsroot/slime/slime.el	2010/09/03 07:25:19	1.1337
@@ -2553,7 +2553,7 @@
              (:conc-name slime-compilation-result.)
              (:constructor nil)
              (:copier nil))
-  tag notes successp duration)
+  tag notes successp duration loadp faslfile)
 
 (defvar slime-last-compilation-result nil
   "The result of the most recently issued compilation.")
@@ -2649,12 +2649,17 @@
    #'slime-compilation-finished))
 
 (defun slime-compilation-finished (result)
-  (with-struct (slime-compilation-result. notes duration successp) result
+  (with-struct (slime-compilation-result. notes duration successp
+                                          loadp faslfile) result
     (setf slime-last-compilation-result result)
     (slime-show-note-counts notes duration successp)
     (when slime-highlight-compiler-notes
       (slime-highlight-notes notes))
-    (run-hook-with-args 'slime-compilation-finished-hook notes)))
+    (run-hook-with-args 'slime-compilation-finished-hook notes)
+    (when (and loadp faslfile 
+               (or successp
+                   (y-or-n-p "Compilation failed.  Load fasl file anyway? ")))
+      (slime-eval-async `(swank:load-file ,faslfile)))))
 
 (defun slime-show-note-counts (notes secs successp)
   (message (concat 
--- /project/slime/cvsroot/slime/swank.lisp	2010/08/15 19:13:57	1.725
+++ /project/slime/cvsroot/slime/swank.lisp	2010/09/03 07:25:19	1.726
@@ -2760,11 +2760,12 @@
 ;;;; Compilation Commands.
 
 (defstruct (:compilation-result
-             (:type list) :named
-             (:constructor make-compilation-result (notes successp duration)))
+             (:type list) :named)
   notes
   (successp nil :type boolean)
-  (duration 0.0 :type float))
+  (duration 0.0 :type float)
+  (loadp nil :type boolean)
+  (faslfile nil :type (or null string)))
 
 (defun measure-time-interval (fun)
   "Call FUN and return the first return value and the elapsed time.
@@ -2788,16 +2789,24 @@
 
 (defun collect-notes (function)
   (let ((notes '()))
-    (multiple-value-bind (successp seconds)
+    (multiple-value-bind (result seconds)
         (handler-bind ((compiler-condition
                         (lambda (c) (push (make-compiler-note c) notes))))
           (measure-time-interval
            (lambda ()
-               ;; To report location of error-signaling toplevel forms
-               ;; for errors in EVAL-WHEN or during macroexpansion.
-               (with-simple-restart (abort "Abort compilation.")
-                 (funcall function)))))
-      (make-compilation-result (reverse notes) (and successp t) seconds))))
+             ;; To report location of error-signaling toplevel forms
+             ;; for errors in EVAL-WHEN or during macroexpansion.
+             (restart-case (multiple-value-list (funcall function))
+               (abort () :report "Abort compilation." (list nil))))))
+      (destructuring-bind (successp &optional loadp faslfile) result
+        (let ((faslfile (etypecase faslfile
+                          (null nil)
+                          (pathname (pathname-to-filename faslfile)))))
+          (make-compilation-result :notes (reverse notes) 
+                                   :duration seconds
+                                   :successp (if successp t)
+                                   :loadp (if loadp t)
+                                   :faslfile faslfile))))))
 
 (defslimefun compile-file-for-emacs (filename load-p &rest options &key policy
                                               &allow-other-keys)
@@ -2811,12 +2820,12 @@
          (multiple-value-bind (output-pathname warnings? failure?)
              (swank-compile-file pathname
                                  (fasl-pathname pathname options)
-                                 load-p
+                                 nil
                                  (or (guess-external-format pathname)
                                      :default)
                                  :policy policy)
-           (declare (ignore output-pathname warnings?))
-           (not failure?)))))))
+           (declare (ignore warnings?))
+           (values (not failure?) load-p output-pathname)))))))
 
 (defvar *fasl-pathname-function* nil
   "In non-nil, use this function to compute the name for fasl-files.")