[slime-cvs] CVS slime

trittweiler trittweiler at common-lisp.net
Thu Jul 17 22:19:12 UTC 2008


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

Modified Files:
	swank-sbcl.lisp swank-backend.lisp slime.el ChangeLog 
Log Message:

	An explicit numeric value as prefix-arg given to `C-c C-c' will
	now represent the debug level the defun is compiled with;
	`C-u C-c C-c' defaults to maximum debug like before. (Now also
	works for recompilation commands in xref buffers.)

	* slime.el (slime-compilation-debug-level): Renamed from
	`slime-compile-with-maximum-debug'.
	(slime-normalize-optimization-level): New.
	(slime-compile-defun): Adapted accordingly.
	(slime-compile-region): Ditto.
	(slime-recompile-location): Added setting of debug-level.
	(slime-recompile-locations): Ditto.
	(slime-recompile-xref): Now takes debug-level prefix-arg.
	(slime-recompile-all-xrefs): Ditto.

	* swank-sbcl.lisp (defimplementation swank-compile-string):
	Adapted accordingly.


--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/07/05 11:48:11	1.198
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/07/17 22:19:11	1.199
@@ -460,7 +460,7 @@
         )
     #+#.(swank-backend::sbcl-with-symbol 'restrict-compiler-policy 'sb-ext)
     (when debug
-      (sb-ext:restrict-compiler-policy 'debug 3))
+      (sb-ext:restrict-compiler-policy 'debug debug))
     (flet ((compile-it (fn)
              (with-compilation-hooks ()
                (with-compilation-unit
@@ -783,7 +783,7 @@
 (defimplementation call-with-debugging-environment (debugger-loop-fn)
   (declare (type function debugger-loop-fn))
   (let* ((*sldb-stack-top* (or sb-debug:*stack-top-hint* (sb-di:top-frame)))
-	 (sb-debug:*stack-top-hint* nil))
+         (sb-debug:*stack-top-hint* nil))
     (handler-bind ((sb-di:debug-condition
 		    (lambda (condition)
                       (signal (make-condition
--- /project/slime/cvsroot/slime/swank-backend.lisp	2008/07/05 11:48:12	1.133
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2008/07/17 22:19:12	1.134
@@ -346,8 +346,9 @@
 rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
 source information.
 
-If DEBUG is supplied, it may be used by certain implementations to
-compile with maximum debugging information.
+If DEBUG is supplied, and non-NIL, it may be used by certain
+implementations to compile with a debug optimization quality of its
+value..
 ")
 
 (definterface swank-compile-file (filename load-p external-format)
--- /project/slime/cvsroot/slime/slime.el	2008/07/16 19:18:51	1.946
+++ /project/slime/cvsroot/slime/slime.el	2008/07/17 22:19:12	1.947
@@ -3723,9 +3723,6 @@
 
 ;;;; 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.")
 
@@ -3753,6 +3750,15 @@
   :group 'slime-mode
   :type 'boolean)
 
+(defvar slime-compilation-debug-level nil
+  "When non-nil compile defuns with this debug optimization level.")
+
+(defun slime-normalize-optimization-level (n)
+  (cond ((not n) nil)
+        ((> n 3) 3)
+        ((< n 0) 0)
+        (t n)))
+
 (defstruct (slime-compilation-unit
              (:type list)
              (:conc-name slime-compilation-unit.)
@@ -3805,10 +3811,16 @@
      (slime-rcurry #'slime-compilation-finished (current-buffer)))
     (message "Compiling %s..." file)))
 
-(defun slime-compile-defun (&optional maximum-debug-p)
-  "Compile the current toplevel form."
+(defun slime-compile-defun (&optional raw-prefix-arg)
+  "Compile the current toplevel form. 
+
+If invoked with a simple prefix-arg (`C-u'), compile the defun
+with maximum debug setting. If invoked with a numeric prefix arg,
+compile with a debug setting of that number."
   (interactive "P")
-  (let ((slime-compile-with-maximum-debug maximum-debug-p))
+  (let* ((prefix-arg (and raw-prefix-arg (prefix-numeric-value raw-prefix-arg)))
+         (debug-level (slime-normalize-optimization-level prefix-arg)) 
+         (slime-compilation-debug-level debug-level))
     (apply #'slime-compile-region (slime-region-for-defun-at-point))))
 
 (defun slime-compile-region (start end)
@@ -3834,7 +3846,7 @@
     ,(buffer-name)
     ,start-offset
     ,(if (buffer-file-name) (file-name-directory (buffer-file-name)))
-    ',slime-compile-with-maximum-debug))
+    ',slime-compilation-debug-level))
 
 (defun slime-make-compilation-finished-continuation (current-buffer &optional emacs-snapshot)
   (lexical-let ((buffer current-buffer) (snapshot emacs-snapshot))
@@ -3909,12 +3921,12 @@
 
 ;;; FIXME: Add maximum-debug-p.
 
-(defun slime-recompile-location (location)
+(defun slime-recompile-location (location &optional debug-level)
   (save-excursion
     (slime-pop-to-location location 'excursion)
-    (slime-compile-defun)))
+    (slime-compile-defun debug-level)))
 
-(defun slime-recompile-locations (locations)
+(defun slime-recompile-locations (locations &optional debug-level)
   (flet ((make-compile-expr (loc)
            (save-excursion
              (slime-pop-to-location loc 'excursion)
@@ -3922,13 +3934,14 @@
                (slime-make-compile-expression-for-swank
                 (buffer-substring-no-properties start end)
                 start)))))
-    (slime-eval-async 
-     `(swank:with-swank-compilation-unit (:override t) 
-        ;; We have to compile each location seperately because of
-        ;; buffer and offset tracking during notes generation.
-        ,@(loop for loc in locations 
-                collect (make-compile-expr loc)))
-     (slime-make-compilation-finished-continuation (current-buffer)))))
+    (let ((slime-compilation-debug-level debug-level))
+      (slime-eval-async 
+       `(swank:with-swank-compilation-unit (:override t) 
+          ;; We have to compile each location seperately because of
+          ;; buffer and offset tracking during notes generation.
+          ,@(loop for loc in locations 
+                  collect (make-compile-expr loc)))
+       (slime-make-compilation-finished-continuation (current-buffer))))))
 
 ;;; FIXME: implement:
 
@@ -6147,26 +6160,34 @@
     (slime-xref-cleanup)
     (slime-set-emacs-snapshot snapshot)))
 
-(defun slime-recompile-xref ()
-  (interactive)
-  (let ((location (slime-xref-location-at-point))
-        (dspec    (slime-xref-dspec-at-point)))
-    (add-hook 'slime-compilation-finished-hook 
-              (slime-make-xref-recompilation-cont (list dspec))
-              nil)
-    (slime-recompile-location location)))
-
-(defun slime-recompile-all-xrefs ()
-  (interactive)
-  (let ((dspecs) (locations))
-    (dolist (xref (slime-all-xrefs))
-      (when (slime-xref-has-location-p xref)
-        (push (slime-xref.dspec xref) dspecs)
-        (push (slime-xref.location xref) locations)))
-    (add-hook 'slime-compilation-finished-hook 
-              (slime-make-xref-recompilation-cont dspecs)
-              nil)
-    (slime-recompile-locations locations)))
+(defun foo (&optional p)
+  (interactive "p")
+  (message "%S" p))
+
+(defun slime-recompile-xref (&optional raw-prefix-arg)
+  (interactive "P")
+  (let* ((prefix-arg (and raw-prefix-arg (prefix-numeric-value raw-prefix-arg)))
+         (debug-level (slime-normalize-optimization-level prefix-arg)))
+    (let ((location (slime-xref-location-at-point))
+          (dspec    (slime-xref-dspec-at-point)))
+      (add-hook 'slime-compilation-finished-hook 
+                (slime-make-xref-recompilation-cont (list dspec))
+                nil)
+      (slime-recompile-location location debug-level))))
+
+(defun slime-recompile-all-xrefs (&optional raw-prefix-arg)
+  (interactive "P")
+  (let* ((prefix-arg (and raw-prefix-arg (prefix-numeric-value raw-prefix-arg)))
+         (debug-level (slime-normalize-optimization-level prefix-arg)))
+    (let ((dspecs) (locations))
+      (dolist (xref (slime-all-xrefs))
+        (when (slime-xref-has-location-p xref)
+          (push (slime-xref.dspec xref) dspecs)
+          (push (slime-xref.location xref) locations)))
+      (add-hook 'slime-compilation-finished-hook 
+                (slime-make-xref-recompilation-cont dspecs)
+                nil)
+      (slime-recompile-locations locations debug-level))))
 
 (defun slime-make-xref-recompilation-cont (dspecs)
   ;; Extreme long-windedness to insert status of recompilation;
--- /project/slime/cvsroot/slime/ChangeLog	2008/07/16 19:18:51	1.1369
+++ /project/slime/cvsroot/slime/ChangeLog	2008/07/17 22:19:12	1.1370
@@ -1,3 +1,23 @@
+2008-07-18  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	An explicit numeric value as prefix-arg given to `C-c C-c' will
+	now represent the debug level the defun is compiled with;
+	`C-u C-c C-c' defaults to maximum debug like before. (Now also
+	works for recompilation commands in xref buffers.)
+
+	* slime.el (slime-compilation-debug-level): Renamed from
+	`slime-compile-with-maximum-debug'.
+	(slime-normalize-optimization-level): New.
+	(slime-compile-defun): Adapted accordingly.
+	(slime-compile-region): Ditto.
+	(slime-recompile-location): Added setting of debug-level.
+	(slime-recompile-locations): Ditto.
+	(slime-recompile-xref): Now takes debug-level prefix-arg.
+	(slime-recompile-all-xrefs): Ditto.
+
+	* swank-sbcl.lisp (defimplementation swank-compile-string):
+	Adapted accordingly.
+
 2008-07-16  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime.el (slime-xref-dspec-at-point): Make more robust.




More information about the slime-cvs mailing list