[slime-cvs] CVS slime

heller heller at common-lisp.net
Thu Apr 17 14:56:45 UTC 2008


Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv17385

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:
C-c C-c with prefix args now uses the maximal debug level.  (By Zach Beane.)
Only implemented for SBCL.

* slime.el (slime-compile-with-maximum-debug): New variable.
(slime-compile-defun, slime-compile-region): Use it.

* swank.lisp (compile-string-for-emacs): Accept new debug
argument. Update backend accordingly.


--- /project/slime/cvsroot/slime/ChangeLog	2008/04/17 14:19:22	1.1343
+++ /project/slime/cvsroot/slime/ChangeLog	2008/04/17 14:56:43	1.1344
@@ -1,3 +1,14 @@
+2008-04-17  Zach Beane <xach at xach.com>
+
+	C-c C-c with prefix args now uses the maximal debug level.
+	Only implemented for SBCL.
+	
+	* slime.el (slime-compile-with-maximum-debug): New variable.
+	(slime-compile-defun, slime-compile-region): Use it.
+
+	* swank.lisp (compile-string-for-emacs): Accept new debug
+	argument. Update backend accordingly.
+
 2008-04-17  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-set-default-directory): Send absolute filenames.
--- /project/slime/cvsroot/slime/slime.el	2008/04/17 14:19:14	1.937
+++ /project/slime/cvsroot/slime/slime.el	2008/04/17 14:56:43	1.938
@@ -3721,6 +3721,9 @@
 
 ;;;; Compilation and the creation of compiler-note annotations
 
+(defvar slime-compile-with-maximum-debug nil
+  "When non-nil compile defuns with maximum debug optimization.")
+
 (defvar slime-highlight-compiler-notes t
   "*When non-nil annotate buffers with compilation notes etc.")
 
@@ -3781,10 +3784,11 @@
      (slime-rcurry #'slime-compilation-finished (current-buffer)))
     (message "Compiling %s..." file)))
 
-(defun slime-compile-defun ()
+(defun slime-compile-defun (&optional maximum-debug-p)
   "Compile the current toplevel form."
-  (interactive)
-  (apply #'slime-compile-region (slime-region-for-defun-at-point)))
+  (interactive "P")
+  (let ((slime-compile-with-maximum-debug maximum-debug-p))
+    (apply #'slime-compile-region (slime-region-for-defun-at-point))))
 
 (defun slime-compile-region (start end)
   "Compile the region."
@@ -3804,7 +3808,8 @@
      ,string
      ,(buffer-name)
      ,start-offset
-     ,(if (buffer-file-name) (file-name-directory (buffer-file-name))))
+     ,(if (buffer-file-name) (file-name-directory (buffer-file-name)))
+     ',slime-compile-with-maximum-debug)
    (slime-make-compilation-finished-continuation (current-buffer))))
 
 (defun slime-note-count-string (severity count &optional suppress-if-zero)
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2008/02/22 14:38:39	1.48
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2008/04/17 14:56:43	1.49
@@ -341,8 +341,9 @@
           (when (and load-p (not fail))
             (load fn)))))))
 
-(defimplementation swank-compile-string (string &key buffer position directory)
-  (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+                                                debug)
+  (declare (ignore directory debug))
   (let ((jvm::*resignal-compiler-warnings* t)
         (*abcl-signaled-conditions* nil))
     (handler-bind ((warning #'handle-compiler-warning))                 
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2008/02/09 18:47:05	1.101
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2008/04/17 14:56:43	1.102
@@ -314,7 +314,9 @@
          (when binary-filename
            (delete-file binary-filename))))))
 
-(defimplementation swank-compile-string (string &key buffer position directory)
+(defimplementation swank-compile-string (string &key buffer position directory
+                                                debug)
+  (declare (ignore debug))
   ;; 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.
--- /project/slime/cvsroot/slime/swank-backend.lisp	2008/02/28 19:44:29	1.130
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2008/04/17 14:56:43	1.131
@@ -333,7 +333,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 directory debug)
   "Compile source from STRING.  During compilation, compiler
 conditions must be trapped and resignalled as COMPILER-CONDITIONs.
 
@@ -344,7 +344,11 @@
 
 If DIRECTORY is specified it may be used by certain implementations to
 rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
-source information.")
+source information.
+
+If DEBUG is supplied, it may be used by certain implementations to
+compile with maximum debugging information.
+")
 
 (definterface swank-compile-file (filename load-p external-format)
    "Compile FILENAME signalling COMPILE-CONDITIONs.
--- /project/slime/cvsroot/slime/swank-clisp.lisp	2008/02/22 14:11:52	1.68
+++ /project/slime/cvsroot/slime/swank-clisp.lisp	2008/04/17 14:56:43	1.69
@@ -573,8 +573,9 @@
           (load fasl-file))
         nil))))
 
-(defimplementation swank-compile-string (string &key buffer position directory)
-  (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+                                                debug)
+  (declare (ignore directory debug))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-offset* position))
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2008/02/09 18:47:05	1.178
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2008/04/17 14:56:43	1.179
@@ -347,8 +347,9 @@
           (when load-p (load output-file)))
         (values output-file warnings-p failure-p)))))
 
-(defimplementation swank-compile-string (string &key buffer position directory)
-  (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+                                                debug)
+  (declare (ignore directory debug))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-start-position* position)
--- /project/slime/cvsroot/slime/swank-corman.lisp	2008/02/09 18:47:05	1.15
+++ /project/slime/cvsroot/slime/swank-corman.lisp	2008/04/17 14:56:43	1.16
@@ -373,8 +373,9 @@
       (when load-p
         (load (compile-file-pathname *compile-filename*))))))
 
-(defimplementation swank-compile-string (string &key buffer position directory)
-  (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+                                                debug)
+  (declare (ignore directory debug))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-position* position)
--- /project/slime/cvsroot/slime/swank-ecl.lisp	2008/03/19 02:34:30	1.15
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2008/04/17 14:56:43	1.16
@@ -131,8 +131,9 @@
           (compile-file *compile-filename*)
         (when load-p (unless fail (load fn)))))))
 
-(defimplementation swank-compile-string (string &key buffer position directory)
-  (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+                                                debug)
+  (declare (ignore directory debug))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-start-position* position)
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2008/03/27 21:59:45	1.98
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2008/04/17 14:56:43	1.99
@@ -558,8 +558,9 @@
 		nil)))
 	   htab))
 
-(defimplementation swank-compile-string (string &key buffer position directory)
-  (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+                                                debug)
+  (declare (ignore directory debug))
   (assert buffer)
   (assert position)
   (let* ((location (list :emacs-buffer buffer position string))
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/02/09 18:47:05	1.124
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/04/17 14:56:43	1.125
@@ -426,8 +426,9 @@
            (mapcan 'who-specializes (ccl::%class-direct-subclasses class)))
    :test 'equal))
 
-(defimplementation swank-compile-string (string &key buffer position directory)
-  (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+                                                debug)
+  (declare (ignore directory debug))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-offset* position)
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/03/26 15:57:37	1.194
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/04/17 14:56:43	1.195
@@ -442,11 +442,15 @@
   "Return a temporary file name to compile strings into."
   (concatenate 'string (tmpnam nil) ".lisp"))
 
-(defimplementation swank-compile-string (string &key buffer position directory)
+(defimplementation swank-compile-string (string &key buffer position directory
+                                                debug)
   (let ((*buffer-name* buffer)
         (*buffer-offset* position)
         (*buffer-substring* string)
-        (filename (temp-file-name)))
+        (filename (temp-file-name))
+        (old-min-debug (assoc 'debug (sb-ext:restrict-compiler-policy))))
+    (when debug
+      (sb-ext:restrict-compiler-policy 'debug 3))
     (flet ((compile-it (fn)
              (with-compilation-hooks ()
                (with-compilation-unit
@@ -462,6 +466,7 @@
                (compile-it #'load)
                (load (compile-it #'identity)))
         (ignore-errors
+          (sb-ext:restrict-compiler-policy 'debug (or old-min-debug 0))
           (delete-file filename)
           (delete-file (compile-file-pathname filename)))))))
 
--- /project/slime/cvsroot/slime/swank-scl.lisp	2008/02/10 08:32:04	1.18
+++ /project/slime/cvsroot/slime/swank-scl.lisp	2008/04/17 14:56:43	1.19
@@ -391,8 +391,9 @@
           (when load-p (load output-file)))
         (values output-file warnings-p failure-p)))))
 
-(defimplementation swank-compile-string (string &key buffer position directory)
-  (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+                                                debug)
+  (declare (ignore directory debug))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-start-position* position)
--- /project/slime/cvsroot/slime/swank.lisp	2008/03/27 11:46:50	1.542
+++ /project/slime/cvsroot/slime/swank.lisp	2008/04/17 14:56:43	1.543
@@ -2230,7 +2230,7 @@
                              (or (guess-external-format filename)
                                  :default)))))))
 
-(defslimefun compile-string-for-emacs (string buffer position directory)
+(defslimefun compile-string-for-emacs (string buffer position directory debug)
   "Compile STRING (exerpted from BUFFER at POSITION).
 Record compiler notes signalled as `compiler-condition's."
   (with-buffer-syntax ()
@@ -2238,7 +2238,8 @@
      (lambda () 
        (let ((*compile-print* nil) (*compile-verbose* t))
          (swank-compile-string string :buffer buffer :position position 
-                               :directory directory))))))
+                               :directory directory
+                               :debug debug))))))
   
 (defun file-newer-p (new-file old-file)
   "Returns true if NEW-FILE is newer than OLD-FILE."




More information about the slime-cvs mailing list