Travis CI | 12 Sep 15:03 2014

Passed: slime/slime#326 (master - eb5420a)

slime / slime (master)
Build #326 passed.
6 minutes and 54 seconds
Helmut Eller eb5420a Changeset →
  next try

Would you like to test your private code?

Travis Pro could be your new best friend!

_______________________________________________
Slime-cvs mailing list
Slime-cvs <at> common-lisp.net
http://common-lisp.net/cgi-bin/mailman/listinfo/slime-cvs
CVS User heller | 17 Nov 08:59 2013
Picon

CVS slime

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
* swank-sbcl.lisp (swank-compile-string): Load the fasl file even
if there were warnings. Just like the other backends do.

--- /project/slime/cvsroot/slime/ChangeLog	2013/11/10 08:11:44	1.2411
+++ /project/slime/cvsroot/slime/ChangeLog	2013/11/17 07:59:04	1.2412
 <at>  <at>  -1,3 +1,8  <at>  <at> 
+2013-11-17  Helmut Eller  <heller <at> common-lisp.net>
+
+	* swank-sbcl.lisp (swank-compile-string): Load the fasl file even
+	if there were warnings. Just like the other backends do.
+
 2013-11-10  Helmut Eller  <heller <at> common-lisp.net>

 	* slime.el (slime-delete-package): New command.
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2013/11/01 14:42:09	1.330
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2013/11/17 07:59:04	1.331
 <at>  <at>  -676,7 +676,9  <at>  <at> 
         (*buffer-substring* string)
         (*buffer-tmpfile* (temp-file-name)))
     (labels ((load-it (filename)
-               (when filename (load filename)))
+               (cond (*trap-load-time-warnings*
+                      (with-compilation-hooks () (load filename)))
+                     (t (load filename))))
              (cf ()
                (with-compiler-policy policy
                  (with-compilation-unit
 <at>  <at>  -686,20 +688,17  <at>  <at> 
                                           :emacs-position position)
                       :source-namestring filename
                       :allow-other-keys t)
-                   (compile-file *buffer-tmpfile* :external-format :utf-8))))
-             (compile-it (cont)
-               (with-compilation-hooks ()
-                 (multiple-value-bind (output-file warningsp failurep) (cf)
-                   (declare (ignore warningsp))
-                   (unless failurep
-                     (funcall cont output-file))))))
+                   (compile-file *buffer-tmpfile* :external-format :utf-8)))))
       (with-open-file (s *buffer-tmpfile* :direction :output :if-exists :error
                          :external-format :utf-8)
         (write-string string s))
       (unwind-protect
-           (if *trap-load-time-warnings*
-               (compile-it #'load-it)
-               (load-it (compile-it #'identity)))
+           (multiple-value-bind (output-file warningsp failurep)
+               (with-compilation-hooks () (cf))
+             (declare (ignore warningsp))
+             (when output-file
+               (load-it output-file))
+             (not failurep))
         (ignore-errors
           (delete-file *buffer-tmpfile*)
           (delete-file (compile-file-pathname *buffer-tmpfile*)))))))

CVS User heller | 10 Nov 09:11 2013
Picon

CVS slime

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
* slime.el (slime-delete-package): New command.
* swank.lisp (swank-delete-package): The corresponding Swank part.

--- /project/slime/cvsroot/slime/ChangeLog	2013/11/10 07:56:20	1.2410
+++ /project/slime/cvsroot/slime/ChangeLog	2013/11/10 08:11:44	1.2411
 <at>  <at>  -1,5 +1,10  <at>  <at> 
 2013-11-10  Helmut Eller  <heller <at> common-lisp.net>

+	* slime.el (slime-delete-package): New command.
+	* swank.lisp (swank-delete-package): The corresponding Swank part.
+
+2013-11-10  Helmut Eller  <heller <at> common-lisp.net>
+
 	* swank.lisp (swank-profile-package): New wrapper for
 	profile-package that does some input validation.
 	* slime.el (slime-profile-package): Use it.
--- /project/slime/cvsroot/slime/slime.el	2013/11/10 07:56:20	1.1431
+++ /project/slime/cvsroot/slime/slime.el	2013/11/10 08:11:44	1.1432
 <at>  <at>  -4421,6 +4421,13  <at>  <at> 
   (slime-eval-async `(swank:unintern-symbol ,symbol-name ,package)
                     (lambda (result) (message "%s" result))))

+(defun slime-delete-package (package-name)
+  "Delete the package with name PACKAGE-NAME."
+  (interactive (list (slime-read-package-name "Delete package: "
+                                              (slime-current-package))))
+  (slime-eval-async `(cl:delete-package
+                      (swank::guess-package ,package-name))))
+
 (defun slime-load-file (filename)
   "Load the Lisp file FILENAME."
   (interactive (list 
--- /project/slime/cvsroot/slime/swank.lisp	2013/11/10 07:56:21	1.804
+++ /project/slime/cvsroot/slime/swank.lisp	2013/11/10 08:11:44	1.805
 <at>  <at>  -2869,7 +2869,7  <at>  <at> 
 (defslimefun unintern-symbol (name package)
   (let ((pkg (guess-package package)))
     (cond ((not pkg) (format nil "No such package: ~s" package))
-          (t 
+          (t
            (multiple-value-bind (sym found) (parse-symbol name pkg)
              (case found
                ((nil) (format nil "~s not in package ~s" name package))
 <at>  <at>  -2877,6 +2877,12  <at>  <at> 
                 (unintern sym pkg)
                 (format nil "Uninterned symbol: ~s" sym))))))))

+(defslimefun swank-delete-package (package-name)
+  (let ((pkg (or (guess-package package-name)
+                 (error "No such package: ~s" package-name))))
+    (delete-package pkg)
+    nil))
+
 
 ;;;; Profiling

CVS User heller | 10 Nov 08:56 2013
Picon

CVS slime

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
* swank.lisp (swank-profile-package): New wrapper for
profile-package that does some input validation.
* slime.el (slime-profile-package): Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2013/11/01 15:38:50	1.2409
+++ /project/slime/cvsroot/slime/ChangeLog	2013/11/10 07:56:20	1.2410
 <at>  <at>  -1,3 +1,9  <at>  <at> 
+2013-11-10  Helmut Eller  <heller <at> common-lisp.net>
+
+	* swank.lisp (swank-profile-package): New wrapper for
+	profile-package that does some input validation.
+	* slime.el (slime-profile-package): Use it.
+
 2013-11-01  Helmut Eller  <heller <at> common-lisp.net>

 	* swank-ccl.lisp (p2-definitions): Check bounds before accessing
--- /project/slime/cvsroot/slime/slime.el	2013/04/23 16:37:14	1.1430
+++ /project/slime/cvsroot/slime/slime.el	2013/11/10 07:56:20	1.1431
 <at>  <at>  -800,8 +800,8  <at>  <at> 
 (defun slime-read-package-name (prompt &optional initial-value)
   "Read a package name from the minibuffer, prompting with PROMPT."
   (let ((completion-ignore-case t))
-    (completing-read prompt (slime-bogus-completion-alist 
-                             (slime-eval 
+    (completing-read prompt (slime-bogus-completion-alist
+                             (slime-eval
                               `(swank:list-all-package-names t)))
 		     nil t initial-value)))

 <at>  <at>  -4490,15 +4490,15  <at>  <at> 
                     (lambda (r) (message "%s" r))))

 (defun slime-profile-package (package callers methods)
-  "Profile all functions in PACKAGE.  
+  "Profile all functions in PACKAGE.
 If CALLER is non-nil names have counts of the most common calling
-functions recorded. 
+functions recorded.
 If METHODS is non-nil, profile all methods of all generic function
 having names in the given package."
   (interactive (list (slime-read-package-name "Package: ")
                      (y-or-n-p "Record the most common callers? ")
                      (y-or-n-p "Profile methods? ")))
-  (slime-eval-async `(swank:profile-package ,package ,callers ,methods)
+  (slime-eval-async `(swank:swank-profile-package ,package ,callers ,methods)
                     (lambda (r) (message "%s" r))))

 (defun slime-profile-by-substring (substring &optional package)
--- /project/slime/cvsroot/slime/swank.lisp	2013/01/11 09:00:30	1.803
+++ /project/slime/cvsroot/slime/swank.lisp	2013/11/10 07:56:21	1.804
 <at>  <at>  -13,7 +13,7  <at>  <at> 
 (defpackage :swank
   (:use :cl :swank-backend :swank-match :swank-rpc)
   (:export #:startup-multiprocessing
-           #:start-server 
+           #:start-server
            #:create-server
            #:stop-server
            #:restart-server
 <at>  <at>  -2910,6 +2910,13  <at>  <at> 
             (maybe-profile symbol))))
     (format nil "~a function~:p ~:*~[are~;is~:;are~] now profiled" count)))

+(defslimefun swank-profile-package (package-name callersp methodsp)
+  (let ((pkg (or (guess-package package-name)
+                 (error "Not a valid package name: ~s" package-name))))
+    (check-type callersp boolean)
+    (check-type methodsp boolean)
+    (profile-package pkg callersp methodsp)))
+
 
 ;;;; Source Locations

CVS User heller | 1 Nov 16:38 2013
Picon

CVS slime

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

Modified Files:
	ChangeLog swank-ccl.lisp 
Log Message:
* swank-ccl.lisp (p2-definitions): Check bounds before accessing
backend-p2-dispatch.

--- /project/slime/cvsroot/slime/ChangeLog	2013/11/01 14:42:09	1.2408
+++ /project/slime/cvsroot/slime/ChangeLog	2013/11/01 15:38:50	1.2409
 <at>  <at>  -1,5 +1,10  <at>  <at> 
 2013-11-01  Helmut Eller  <heller <at> common-lisp.net>

+	* swank-ccl.lisp (p2-definitions): Check bounds before accessing
+	backend-p2-dispatch.
+
+2013-11-01  Helmut Eller  <heller <at> common-lisp.net>
+
 	* swank-sbcl.lisp (swank-compile-string): Fix last commit.  Honor
 	*trap-load-time-warnings* but without calling LOAD inside
 	WITH-COMPILATION-UNIT.
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2013/09/29 13:45:42	1.34
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2013/11/01 15:38:50	1.35
 <at>  <at>  -552,10 +552,11  <at>  <at> 
 (defun p2-definitions (name)
   (let ((nx1-op (gethash name ccl::*nx1-operators*)))
     (and nx1-op
-         (let ((p2 (aref (ccl::backend-p2-dispatch ccl::*target-backend*)
-                         nx1-op)))
-           (and p2
-                (ccl:find-definition-sources p2))))))
+         (let ((dispatch (ccl::backend-p2-dispatch ccl::*target-backend*)) )
+           (and (array-in-bounds-p dispatch nx1-op)
+                (let ((p2 (aref dispatch nx1-op)))
+                  (and p2
+                       (ccl:find-definition-sources p2))))))))

 (defimplementation find-definitions (name)
   (let ((defs (append (or (ccl:find-definition-sources name)

CVS User heller | 1 Nov 15:42 2013
Picon

CVS slime

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
* swank-sbcl.lisp (swank-compile-string): Fix last commit.  Honor
*trap-load-time-warnings* but without calling LOAD inside
WITH-COMPILATION-UNIT.

--- /project/slime/cvsroot/slime/ChangeLog	2013/10/31 07:55:49	1.2407
+++ /project/slime/cvsroot/slime/ChangeLog	2013/11/01 14:42:09	1.2408
 <at>  <at>  -1,3 +1,9  <at>  <at> 
+2013-11-01  Helmut Eller  <heller <at> common-lisp.net>
+
+	* swank-sbcl.lisp (swank-compile-string): Fix last commit.  Honor
+	*trap-load-time-warnings* but without calling LOAD inside
+	WITH-COMPILATION-UNIT.
+
 2013-10-31  Helmut Eller  <heller <at> common-lisp.net>

 	* swank-sbcl.lisp (swank-compile-string): Don't call LOAD inside
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2013/10/31 07:55:49	1.329
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2013/11/01 14:42:09	1.330
 <at>  <at>  -607,9 +607,6  <at>  <at> 
        (warning                   #'handle-notification-condition))
     (funcall function)))

-
-(defvar *trap-load-time-warnings* t)
-
 (defun compiler-policy (qualities)
   "Return compiler policy qualities present in the QUALITIES alist.
 QUALITIES is an alist with (quality . value)"
 <at>  <at>  -633,7 +630,7  <at>  <at> 
        (unwind-protect (progn , <at> body)
          (setf (compiler-policy) ,current-policy)))))

-(defimplementation swank-compile-file (input-file output-file 
+(defimplementation swank-compile-file (input-file output-file
                                        load-p external-format
                                        &key policy)
   (multiple-value-bind (output-file warnings-p failure-p)
 <at>  <at>  -645,7 +642,7  <at>  <at> 
             (or failure-p
                 (when load-p
                   ;; Cache the latest source file for definition-finding.
-                  (source-cache-get input-file 
+                  (source-cache-get input-file
                                     (file-write-date input-file))
                   (not (load output-file)))))))

 <at>  <at>  -670,36 +667,39  <at>  <at> 
   "Return a temporary file name to compile strings into."
   (tempnam nil nil))

+(defvar *trap-load-time-warnings* t)
+
 (defimplementation swank-compile-string (string &key buffer position filename
                                          policy)
   (let ((*buffer-name* buffer)
         (*buffer-offset* position)
         (*buffer-substring* string)
         (*buffer-tmpfile* (temp-file-name)))
-    (flet ((load-it (filename)
-             (when filename (load filename)))
-           (compile-it (cont)
-             (multiple-value-bind (output-file warningsp failurep)
-                 (with-compilation-hooks ()
-                   (with-compilation-unit
-                       (:source-plist (list :emacs-buffer buffer
-                                            :emacs-filename filename
-                                            :emacs-string string
-                                            :emacs-position position)
-                        :source-namestring filename
-                        :allow-other-keys t)
-                     (compile-file *buffer-tmpfile* :external-format :utf-8)))
-               (declare (ignore warningsp))
-               (unless failurep
-                 (funcall cont output-file)))))
+    (labels ((load-it (filename)
+               (when filename (load filename)))
+             (cf ()
+               (with-compiler-policy policy
+                 (with-compilation-unit
+                     (:source-plist (list :emacs-buffer buffer
+                                          :emacs-filename filename
+                                          :emacs-string string
+                                          :emacs-position position)
+                      :source-namestring filename
+                      :allow-other-keys t)
+                   (compile-file *buffer-tmpfile* :external-format :utf-8))))
+             (compile-it (cont)
+               (with-compilation-hooks ()
+                 (multiple-value-bind (output-file warningsp failurep) (cf)
+                   (declare (ignore warningsp))
+                   (unless failurep
+                     (funcall cont output-file))))))
       (with-open-file (s *buffer-tmpfile* :direction :output :if-exists :error
                          :external-format :utf-8)
         (write-string string s))
       (unwind-protect
-           (with-compiler-policy policy
-            (if *trap-load-time-warnings*
-                (compile-it #'load-it)
-                (load-it (compile-it #'identity))))
+           (if *trap-load-time-warnings*
+               (compile-it #'load-it)
+               (load-it (compile-it #'identity)))
         (ignore-errors
           (delete-file *buffer-tmpfile*)
           (delete-file (compile-file-pathname *buffer-tmpfile*)))))))

CVS User heller | 31 Oct 08:55 2013
Picon

CVS slime

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
* swank-sbcl.lisp (swank-compile-string): Don't call LOAD inside
WITH-COMPILATION-UNIT.

--- /project/slime/cvsroot/slime/ChangeLog	2013/09/29 13:45:42	1.2406
+++ /project/slime/cvsroot/slime/ChangeLog	2013/10/31 07:55:49	1.2407
 <at>  <at>  -1,3 +1,8  <at>  <at> 
+2013-10-31  Helmut Eller  <heller <at> common-lisp.net>
+
+	* swank-sbcl.lisp (swank-compile-string): Don't call LOAD inside
+	WITH-COMPILATION-UNIT.
+
 2013-09-29  Helmut Eller  <heller <at> common-lisp.net>

 	For CCL, also search definitions of p2 translators.
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2013/02/02 10:11:16	1.328
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2013/10/31 07:55:49	1.329
 <at>  <at>  -679,19 +679,19  <at>  <at> 
     (flet ((load-it (filename)
              (when filename (load filename)))
            (compile-it (cont)
-             (with-compilation-hooks ()
-               (with-compilation-unit
-                   (:source-plist (list :emacs-buffer buffer
-                                        :emacs-filename filename
-                                        :emacs-string string
-                                        :emacs-position position)
-                    :source-namestring filename
-                    :allow-other-keys t)
-                 (multiple-value-bind (output-file warningsp failurep)
-                     (compile-file *buffer-tmpfile* :external-format :utf-8)
-                   (declare (ignore warningsp))
-                   (unless failurep
-                     (funcall cont output-file)))))))
+             (multiple-value-bind (output-file warningsp failurep)
+                 (with-compilation-hooks ()
+                   (with-compilation-unit
+                       (:source-plist (list :emacs-buffer buffer
+                                            :emacs-filename filename
+                                            :emacs-string string
+                                            :emacs-position position)
+                        :source-namestring filename
+                        :allow-other-keys t)
+                     (compile-file *buffer-tmpfile* :external-format :utf-8)))
+               (declare (ignore warningsp))
+               (unless failurep
+                 (funcall cont output-file)))))
       (with-open-file (s *buffer-tmpfile* :direction :output :if-exists :error
                          :external-format :utf-8)
         (write-string string s))

CVS User heller | 29 Sep 15:45 2013
Picon

CVS slime

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

Modified Files:
	ChangeLog swank-ccl.lisp 
Log Message:
For CCL, also search definitions of p2 translators.

* swank-ccl.lisp (p2-definitions): New.
(find-definitions): Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2013/09/29 07:39:48	1.2405
+++ /project/slime/cvsroot/slime/ChangeLog	2013/09/29 13:45:42	1.2406
 <at>  <at>  -1,5 +1,12  <at>  <at> 
 2013-09-29  Helmut Eller  <heller <at> common-lisp.net>

+	For CCL, also search definitions of p2 translators.
+
+	* swank-ccl.lisp (p2-definitions): New.
+	(find-definitions): Use it.
+
+2013-09-29  Helmut Eller  <heller <at> common-lisp.net>
+
 	* swank-clisp.lisp (*frame-prefixes*): Update some of the patterns
 	for new layout.
 	(is-prefix-p): Use regexp matching.
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2013/09/29 07:39:39	1.33
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2013/09/29 13:45:42	1.34
 <at>  <at>  -549,13 +549,22  <at>  <at> 
   (let ((alpha (gethash name ccl::*nx1-alphatizers*)))
     (and alpha (ccl:find-definition-sources alpha))))

+(defun p2-definitions (name)
+  (let ((nx1-op (gethash name ccl::*nx1-operators*)))
+    (and nx1-op
+         (let ((p2 (aref (ccl::backend-p2-dispatch ccl::*target-backend*)
+                         nx1-op)))
+           (and p2
+                (ccl:find-definition-sources p2))))))
+
 (defimplementation find-definitions (name)
   (let ((defs (append (or (ccl:find-definition-sources name)
                           (and (symbolp name)
                                (fboundp name)
                                (ccl:find-definition-sources
                                 (symbol-function name))))
-                      (alphatizer-definitions name))))
+                      (alphatizer-definitions name)
+                      (p2-definitions name))))
     (loop for ((type . name) . sources) in defs
           collect (list (definition-name type name)
                         (source-note-to-source-location

CVS User heller | 29 Sep 09:39 2013
Picon

CVS slime

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

Modified Files:
	ChangeLog swank-clisp.lisp 
Log Message:
* swank-clisp.lisp (*frame-prefixes*): Update some of the patterns
for new layout.
(is-prefix-p): Use regexp matching.
(boring-frame-p): Also make compiled-tagbody compiled-block
boring.
(sldb-backtrace, %parse-stack-values): Remove code for versions
before 2.44.

--- /project/slime/cvsroot/slime/ChangeLog	2013/09/29 07:39:39	1.2404
+++ /project/slime/cvsroot/slime/ChangeLog	2013/09/29 07:39:48	1.2405
 <at>  <at>  -1,5 +1,15  <at>  <at> 
 2013-09-29  Helmut Eller  <heller <at> common-lisp.net>

+	* swank-clisp.lisp (*frame-prefixes*): Update some of the patterns
+	for new layout.
+	(is-prefix-p): Use regexp matching.
+	(boring-frame-p): Also make compiled-tagbody compiled-block
+	boring.
+	(sldb-backtrace, %parse-stack-values): Remove code for versions
+	before 2.44.
+
+2013-09-29  Helmut Eller  <heller <at> common-lisp.net>
+
 	For CCL, also search nx1-alphatizer definitions.

 	* swank-ccl.lisp (alphatizer-definitions): New
--- /project/slime/cvsroot/slime/swank-clisp.lisp	2013/02/02 10:11:16	1.103
+++ /project/slime/cvsroot/slime/swank-clisp.lisp	2013/09/29 07:39:48	1.104
 <at>  <at>  -36,6 +36,10  <at>  <at> 

 (in-package :swank-backend)

+(eval-when (:compile-toplevel)
+  (unless (string< "2.44" (lisp-implementation-version))
+    (error "Need at least CLISP version 2.44")))
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
   ;;(use-package "SOCKET")
   (use-package "GRAY"))
 <at>  <at>  -359,54 +363,59  <at>  <at> 

 (defvar *sldb-backtrace*)

-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (when (string< "2.44" (lisp-implementation-version))
-    (pushnew :clisp-2.44+ *features*)))
-
 (defun sldb-backtrace ()
   "Return a list ((ADDRESS . DESCRIPTION) ...) of frames."
-  (do ((frames '())
-       (last nil frame)
-       (frame (sys::the-frame)
-              #+clisp-2.44+ (sys::frame-up 1 frame 1)
-              #-clisp-2.44+ (sys::frame-up-1 frame 1))) ; 1 = "all frames"
-      ((eq frame last) (nreverse frames))
-    (unless (boring-frame-p frame)
-      (push frame frames))))
+  (let* ((modes '((:all-stack-elements 1)
+                  (:all-frames 2)
+                  (:only-lexical-frames 3)
+                  (:only-eval-and-apply-frames 4)
+                  (:only-apply-frames 5)))
+         (mode (cadr (assoc :all-stack-elements modes))))
+    (do ((frames '())
+         (last nil frame)
+         (frame (sys::the-frame)
+                (sys::frame-up 1 frame mode)))
+        ((eq frame last) (nreverse frames))
+      (unless (boring-frame-p frame)
+        (push frame frames)))))

 (defimplementation call-with-debugging-environment (debugger-loop-fn)
   (let* (;;(sys::*break-count* (1+ sys::*break-count*))
          ;;(sys::*driver* debugger-loop-fn)
          ;;(sys::*fasoutput-stream* nil)
          (*sldb-backtrace*
-          (nthcdr 3 (member (sys::the-frame) (sldb-backtrace)))))
+          (let* ((f (sys::the-frame))
+                 (bt (sldb-backtrace))
+                 (rest (member f bt)))
+            (if rest (nthcdr 8 rest) bt))))
     (funcall debugger-loop-fn)))

 (defun nth-frame (index)
   (nth index *sldb-backtrace*))

 (defun boring-frame-p (frame)
-  (member (frame-type frame) '(stack-value bind-var bind-env)))
+  (member (frame-type frame) '(stack-value bind-var bind-env
+                               compiled-tagbody compiled-block)))

 (defun frame-to-string (frame)
   (with-output-to-string (s)
     (sys::describe-frame s frame)))

-;; FIXME: they changed the layout in 2.44 so the frame-to-string &
-;; string-matching silliness no longer works.
 (defun frame-type (frame)
   ;; FIXME: should bind *print-length* etc. to small values.
   (frame-string-type (frame-to-string frame)))

+;; FIXME: they changed the layout in 2.44 and not all patterns have
+;; been updated.
 (defvar *frame-prefixes*
-  '(("frame binding variables" bind-var)
+  '(("\\[[0-9]\\+\\] frame binding variables" bind-var)
     ("<1> #<compiled-function" compiled-fun)
     ("<1> #<system-function" sys-fun)
     ("<1> #<special-operator" special-op)
     ("EVAL frame" eval)
     ("APPLY frame" apply)
-    ("compiled tagbody frame" compiled-tagbody)
-    ("compiled block frame" compiled-block)
+    ("\\[[0-9]\\+\\] compiled tagbody frame" compiled-tagbody)
+    ("\\[[0-9]\\+\\] compiled block frame" compiled-block)
     ("block frame" block)
     ("nested block frame" block)
     ("tagbody frame" tagbody)
 <at>  <at>  -415,11 +424,12  <at>  <at> 
     ("handler frame" handler)
     ("unwind-protect frame" unwind-protect)
     ("driver frame" driver)
-    ("frame binding environments" bind-env)
+    ("\\[[0-9]\\+\\] frame binding environments" bind-env)
     ("CALLBACK frame" callback)
     ("- " stack-value)
     ("<1> " fun)
-    ("<2> " 2nd-frame)))
+    ("<2> " 2nd-frame)
+    ))

 (defun frame-string-type (string)
   (cadr (assoc-if (lambda (pattern) (is-prefix-p pattern string))
 <at>  <at>  -529,9 +539,7  <at>  <at> 
         (venv-ref (next-venv env) (- i (/ (1- (length env)) 2))))))

 (defun %parse-stack-values (frame)
-  (labels ((next (fp)
-             #+clisp-2.44+ (sys::frame-down 1 fp 1)
-             #-clisp-2.44+ (sys::frame-down-1 fp 1))
+  (labels ((next (fp) (sys::frame-down 1 fp 1))
            (parse (fp accu)
              (let ((str (frame-to-string fp)))
                (cond ((is-prefix-p "- " str)
 <at>  <at>  -546,11 +554,8  <at>  <at> 
                      (t (parse (next fp) accu))))))
     (parse (next frame) '())))

-(setq *features* (remove :clisp-2.44+ *features*))
-
-(defun is-prefix-p (pattern string)
-  (not (mismatch pattern string :end2 (min (length pattern)
-                                           (length string)))))
+(defun is-prefix-p (regexp string)
+  (if (regexp:match (concatenate 'string "^" regexp) string) t))

 (defimplementation return-from-frame (index form)
   (sys::return-from-eval-frame (nth-frame index) form))

CVS User heller | 29 Sep 09:39 2013
Picon

CVS slime

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

Modified Files:
	ChangeLog swank-ccl.lisp 
Log Message:
For CCL, also search nx1-alphatizer definitions.

* swank-ccl.lisp (alphatizer-definitions): New
(find-definitions): Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2013/06/26 11:51:50	1.2403
+++ /project/slime/cvsroot/slime/ChangeLog	2013/09/29 07:39:39	1.2404
 <at>  <at>  -1,3 +1,10  <at>  <at> 
+2013-09-29  Helmut Eller  <heller <at> common-lisp.net>
+
+	For CCL, also search nx1-alphatizer definitions.
+
+	* swank-ccl.lisp (alphatizer-definitions): New
+	(find-definitions): Use it.
+
 2013-06-26  evenson  <evenson <at> saturn>

 	* swank-abcl.lisp (specializer-direct-methods): Correct symbol
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2013/02/02 10:11:16	1.32
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2013/09/29 07:39:39	1.33
 <at>  <at>  -545,11 +545,17  <at>  <at> 
               (t `(:error ,(funcall if-nil-thunk))))
       (error (c) `(:error ,(princ-to-string c))))))

+(defun alphatizer-definitions (name)
+  (let ((alpha (gethash name ccl::*nx1-alphatizers*)))
+    (and alpha (ccl:find-definition-sources alpha))))
+
 (defimplementation find-definitions (name)
-  (let ((defs (or (ccl:find-definition-sources name)
-                  (and (symbolp name)
-                       (fboundp name)
-                       (ccl:find-definition-sources (symbol-function name))))))
+  (let ((defs (append (or (ccl:find-definition-sources name)
+                          (and (symbolp name)
+                               (fboundp name)
+                               (ccl:find-definition-sources
+                                (symbol-function name))))
+                      (alphatizer-definitions name))))
     (loop for ((type . name) . sources) in defs
           collect (list (definition-name type name)
                         (source-note-to-source-location

CVS User heller | 26 May 10:24 2013
Picon

CVS slime

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

Modified Files:
	ChangeLog 
Log Message:
Forgot to update ChangeLog.

--- /project/slime/cvsroot/slime/ChangeLog	2013/05/14 15:46:08	1.2401
+++ /project/slime/cvsroot/slime/ChangeLog	2013/05/26 08:24:01	1.2402
 <at>  <at>  -1,3 +1,9  <at>  <at> 
+2013-05-26  Luís Oliveira  <loliveira <at> common-lisp.net>
+
+	* slime-fancy-trace.el: New contrib.
+	* slime-parse.el (slime-trace-query): moved to slime-fancy-trace.
+	* slime-fancy.el: load slime-fancy-trace.
+
 2013-05-14  Martin Simmons  <martin <at> lispworks.com>

 	* swank-lispworks.lisp (lispworks-severity): Fix error when using


Gmane