From sboukarev at common-lisp.net  Tue Sep  1 12:56:23 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Tue, 01 Sep 2009 08:56:23 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MiSuN-0005mV-D3@common-lisp.net>

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

Modified Files:
	ChangeLog swank-arglists.lisp 
Log Message:
* swank-arglists.lisp (decode-required-arg): Arglists for some forms
in LispWorks, e.g. flet, contain strings, so handle strings too.
Reported by Nick Levine.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/28 23:50:48	1.239
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/01 12:56:23	1.240
@@ -1,3 +1,9 @@
+2009-09-01  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-arglists.lisp (decode-required-arg): Arglists for some forms
+	in LispWorks, e.g. flet, contain strings, so handle strings too.
+	Reported by Nick Levine.
+
 2009-08-28  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-c-p-c.el (slime-contextual-completions): Remove debugging code.
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/05/20 19:25:58	1.32
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/09/01 12:56:23	1.33
@@ -502,7 +502,10 @@
   "ARG can be a symbol or a destructuring pattern."
   (etypecase arg
     (symbol arg)
-    (list   (decode-arglist arg))))
+    (list   (decode-arglist arg))
+    ;; Arglists for some forms in LispWorks, e.g. flet, contain strings.
+    #+lispworks
+    (string arg)))
 
 (defun encode-required-arg (arg)
   (etypecase arg




From sboukarev at common-lisp.net  Wed Sep  2 14:04:31 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 02 Sep 2009 10:04:31 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MiqRr-0001gQ-ND@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-net-close): Do not query for process killing
confirmation before killing a connection buffer.
(slime-buffer-processes): New function for listing processes
associated with a buffer.


--- /project/slime/cvsroot/slime/ChangeLog	2009/08/31 17:08:17	1.1847
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/02 14:04:31	1.1848
@@ -1,3 +1,10 @@
+2009-09-02  Stas Boukarev  <stassats at gmail.com>
+
+	* slime.el (slime-net-close): Do not query for process killing
+	confirmation before killing a connection buffer.
+	(slime-buffer-processes): New function for listing processes
+	associated with a buffer.
+
 2009-08-31  Helmut Eller  <heller at common-lisp.net>
 
 	Don't advice ccl::break-loop.
--- /project/slime/cvsroot/slime/slime.el	2009/08/31 17:08:09	1.1218
+++ /project/slime/cvsroot/slime/slime.el	2009/09/02 14:04:31	1.1219
@@ -1693,6 +1693,12 @@
         (and (not (multibyte-string-p string))
              (not (slime-coding-system-mulibyte-p coding-system))))))
 
+(defun slime-buffer-processes (buffer)
+  "List all processes associated with BUFFER."
+  (remove* buffer (process-list)
+           :key 'process-buffer
+           :test-not 'eq))
+
 (defun slime-net-close (process &optional debug)
   (setq slime-net-processes (remove process slime-net-processes))
   (when (eq process slime-default-connection)
@@ -1703,6 +1709,9 @@
          (delete-process process))
         (t
          (run-hook-with-args 'slime-net-process-close-hooks process)
+         ;; there might be more than one process
+         (dolist (process (slime-buffer-processes (process-buffer process)))
+           (set-process-query-on-exit-flag process nil))
          ;; killing the buffer also closes the socket
          (kill-buffer (process-buffer process)))))
 




From sboukarev at common-lisp.net  Wed Sep  2 17:21:16 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 02 Sep 2009 13:21:16 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MitWG-0005Sj-68@common-lisp.net>

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

Modified Files:
	ChangeLog swank-lispworks.lisp 
Log Message:
* swank-lispworks.lisp (replace-strings-with-symbols): New function for
recursively interning and replacing strings in a list.
(arglist): Replace all strings in arglists with symbols.

* contrib/swank-arglists.lisp (decode-required-arg): Move LispWorks specific
code into swank-lispworks.lisp.


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/02 14:04:31	1.1848
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/02 17:21:15	1.1849
@@ -1,5 +1,9 @@
 2009-09-02  Stas Boukarev  <stassats at gmail.com>
 
+	* swank-lispworks.lisp (replace-strings-with-symbols): New function for
+	recursively interning and replacing strings in a list.
+	(arglist): Replace all strings in arglists with symbols.
+
 	* slime.el (slime-net-close): Do not query for process killing
 	confirmation before killing a connection buffer.
 	(slime-buffer-processes): New function for listing processes
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/07/02 14:14:33	1.131
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/09/02 17:21:15	1.132
@@ -184,13 +184,26 @@
 
 ;;;; Documentation
 
+(defun replace-strings-with-symbols (tree)
+  (mapcar (lambda (x)
+            (typecase x
+              (list
+               (replace-strings-with-symbols x))
+              (symbol
+               x)
+              (string
+               (intern x))
+              (t
+               (intern (write-to-string x)))))
+          tree))
+               
 (defimplementation arglist (symbol-or-function)
   (let ((arglist (lw:function-lambda-list symbol-or-function)))
     (etypecase arglist
       ((member :dont-know) 
        :not-available)
       (list
-       arglist))))
+       (replace-strings-with-symbols arglist)))))
 
 (defimplementation function-name (function)
   (nth-value 2 (function-lambda-expression function)))




From sboukarev at common-lisp.net  Wed Sep  2 17:21:16 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 02 Sep 2009 13:21:16 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MitWG-0005T0-GU@common-lisp.net>

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

Modified Files:
	ChangeLog swank-arglists.lisp 
Log Message:
* swank-lispworks.lisp (replace-strings-with-symbols): New function for
recursively interning and replacing strings in a list.
(arglist): Replace all strings in arglists with symbols.

* contrib/swank-arglists.lisp (decode-required-arg): Move LispWorks specific
code into swank-lispworks.lisp.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/01 12:56:23	1.240
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/02 17:21:16	1.241
@@ -1,3 +1,8 @@
+2009-09-02  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-arglists.lisp (decode-required-arg): Move LispWorks specific
+	code into swank-lispworks.lisp.
+
 2009-09-01  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-arglists.lisp (decode-required-arg): Arglists for some forms
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/09/01 12:56:23	1.33
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/09/02 17:21:16	1.34
@@ -502,10 +502,7 @@
   "ARG can be a symbol or a destructuring pattern."
   (etypecase arg
     (symbol arg)
-    (list   (decode-arglist arg))
-    ;; Arglists for some forms in LispWorks, e.g. flet, contain strings.
-    #+lispworks
-    (string arg)))
+    (list   (decode-arglist arg))))
 
 (defun encode-required-arg (arg)
   (etypecase arg




From heller at common-lisp.net  Thu Sep  3 07:43:08 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 03 Sep 2009 03:43:08 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1Mj6yK-0005Ek-Tr@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-net-close): set-process-query-on-exit-flag
doesn't exist in XEmacs.
(slime-make-net-buffer): For now, disable querying here.
Could also close the socket before killing the buffer.
(slime-buffer-processes): Deleted.

--- /project/slime/cvsroot/slime/ChangeLog	2009/09/02 17:21:15	1.1849
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/03 07:43:08	1.1850
@@ -1,3 +1,11 @@
+2009-09-03  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-net-close): set-process-query-on-exit-flag
+	doesn't exist in XEmacs.
+	(slime-make-net-buffer): For now, disable querying here.
+	Could also close the socket before killing the buffer.
+	(slime-buffer-processes): Deleted.
+
 2009-09-02  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-lispworks.lisp (replace-strings-with-symbols): New function for
--- /project/slime/cvsroot/slime/slime.el	2009/09/02 14:04:31	1.1219
+++ /project/slime/cvsroot/slime/slime.el	2009/09/03 07:43:08	1.1220
@@ -1634,7 +1634,8 @@
   "Make a buffer suitable for a network process."
   (let ((buffer (generate-new-buffer name)))
     (with-current-buffer buffer
-      (buffer-disable-undo))
+      (buffer-disable-undo)
+      (set (make-local-variable 'kill-buffer-query-functions) nil))
     buffer))
 
 (defun slime-set-query-on-exit-flag (process)
@@ -1693,12 +1694,6 @@
         (and (not (multibyte-string-p string))
              (not (slime-coding-system-mulibyte-p coding-system))))))
 
-(defun slime-buffer-processes (buffer)
-  "List all processes associated with BUFFER."
-  (remove* buffer (process-list)
-           :key 'process-buffer
-           :test-not 'eq))
-
 (defun slime-net-close (process &optional debug)
   (setq slime-net-processes (remove process slime-net-processes))
   (when (eq process slime-default-connection)
@@ -1709,9 +1704,6 @@
          (delete-process process))
         (t
          (run-hook-with-args 'slime-net-process-close-hooks process)
-         ;; there might be more than one process
-         (dolist (process (slime-buffer-processes (process-buffer process)))
-           (set-process-query-on-exit-flag process nil))
          ;; killing the buffer also closes the socket
          (kill-buffer (process-buffer process)))))
 




From sboukarev at common-lisp.net  Fri Sep  4 13:00:42 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 04 Sep 2009 09:00:42 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MjYPC-0006Dq-VB@common-lisp.net>

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

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
* slime-repl.el (slime-sync-package-and-default-directory):
Don't change package if it's unknown. Use existing functions for
changing package and directory.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/02 17:21:16	1.241
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/04 13:00:42	1.242
@@ -1,3 +1,9 @@
+2009-09-04  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-repl.el (slime-sync-package-and-default-directory):
+	Don't change package if it's unknown. Use existing functions for
+	changing package and directory.
+
 2009-09-02  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-arglists.lisp (decode-required-arg): Move LispWorks specific
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/07/02 17:00:25	1.23
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/09/04 13:00:42	1.24
@@ -1448,23 +1448,21 @@
 (defun slime-sync-package-and-default-directory ()
   "Set Lisp's package and directory to the values in current buffer."
   (interactive)
-  (let ((package (slime-repl-shortcut-eval `(swank:set-package 
-                                             ,(slime-find-buffer-package))))
-	(directory (slime-from-lisp-filename
-                    (slime-repl-shortcut-eval `(swank:set-default-directory 
-                                                ,(slime-to-lisp-filename
-                                                  default-directory))))))
-    (let ((dir default-directory))
-      ;; Sync REPL dir
-      (with-current-buffer (slime-output-buffer)
-        (setq default-directory dir))
-      ;; Sync *inferior-lisp* dir
-      (let* ((proc (slime-process))
-             (buffer (and proc (process-buffer proc))))
-        (when buffer 
-          (with-current-buffer buffer
-            (setq default-directory dir)))))
-    (message "package: %s  default-directory: %s" (car package) directory)))
+  (let ((package (slime-current-package))
+        (directory default-directory))
+    (when package
+      (slime-repl-set-package package))
+    (slime-set-default-directory directory)
+    ;; Sync *inferior-lisp* dir
+    (let* ((proc (slime-process))
+           (buffer (and proc (process-buffer proc))))
+      (when buffer
+        (with-current-buffer buffer
+          (setq default-directory directory))))
+    (message "package: %s  default-directory: %s"
+             (with-current-buffer (slime-output-buffer)
+               (slime-lisp-package))
+             directory)))
 
 (defun slime-goto-connection ()
   "Switch to the REPL buffer for the connection at point."




From heller at common-lisp.net  Tue Sep  8 05:59:21 2009
From: heller at common-lisp.net (CVS User heller)
Date: Tue, 08 Sep 2009 01:59:21 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1Mktjd-0000BM-3q@common-lisp.net>

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

Modified Files:
	ChangeLog swank-loader.lisp 
Log Message:
* swank-loader.lisp (lisp-version-string): Include "-ics" for
version with extended charsets.  Suggested by Scott L. Burson.

--- /project/slime/cvsroot/slime/ChangeLog	2009/09/03 07:43:08	1.1850
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/08 05:59:20	1.1851
@@ -1,3 +1,8 @@
+2009-09-08  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-loader.lisp (lisp-version-string): Include "-ics" for
+	version with extended charsets.  Suggested by Scott L. Burson.
+
 2009-09-03  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-net-close): set-process-query-on-exit-flag
--- /project/slime/cvsroot/slime/swank-loader.lisp	2009/07/26 08:00:40	1.91
+++ /project/slime/cvsroot/slime/swank-loader.lisp	2009/09/08 05:59:20	1.92
@@ -62,11 +62,13 @@
                                     (lisp-implementation-version))
   #+(or cormanlisp scl sbcl ecl)       (lisp-implementation-version)
   #+lispworks (lisp-implementation-version)
-  #+allegro   (format nil
-                      "~A~A~A"
+  #+allegro   (format nil "~A~A~A~A"
                       excl::*common-lisp-version-number*
                       (if (eq 'h 'H) "A" "M")     ; ANSI vs MoDeRn
-                      (if (member :64bit *features*) "-64bit" ""))
+                      (if (member :64bit *features*) "-64bit" "")
+                      (excl:ics-target-case
+                       (:-ics "")
+                       (:+ics "-ics")))
   #+clisp     (let ((s (lisp-implementation-version)))
                 (subseq s 0 (position #\space s)))
   #+armedbear (lisp-implementation-version))




From mevenson at common-lisp.net  Sat Sep 12 08:47:31 2009
From: mevenson at common-lisp.net (CVS User mevenson)
Date: Sat, 12 Sep 2009 04:47:31 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MmOGZ-0005oJ-2d@common-lisp.net>

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

Modified Files:
	ChangeLog swank-abcl.lisp 
Log Message:
Provided by Alan Ruttenberg.
 
  	* swank-abcl.lisp (source-location): Make edit definition work.
 
 	* swank-abcl.lisp (arglist): Now works with generic functions.


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/08 05:59:20	1.1851
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/12 08:47:30	1.1852
@@ -1,3 +1,12 @@
+2009-09-12  Mark Evenson  <evenson at panix.com>
+
+	Provided by Alan Ruttenberg.
+
+	* swank-abcl.lisp (source-location): Make edit definition work.
+
+	* swank-abcl.lisp (arglist): Now works with generic functions.
+
+
 2009-09-08  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-loader.lisp (lisp-version-string): Include "-ics" for
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/08/19 14:58:02	1.68
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/09/12 08:47:30	1.69
@@ -213,7 +213,12 @@
 
 (defimplementation arglist (fun)
   (cond ((symbolp fun)
-         (multiple-value-bind (arglist present) (sys::arglist fun)
+         (multiple-value-bind (arglist present) 
+             (or (sys::arglist fun)
+                 (and (fboundp fun)
+                      (typep (symbol-function fun) 'standard-generic-function)
+                      (let ((it (mop::generic-function-lambda-list (symbol-function fun))))
+                        (values it it))))
            (if present arglist :not-available)))
         (t :not-available)))
 
@@ -430,12 +435,14 @@
 
 (defun source-location (symbol)
   (when (pathnamep (ext:source-pathname symbol))
-    `(((,symbol)
-       (:location 
-        (:file ,(namestring (ext:source-pathname symbol)))
-        (:position ,(or (ext:source-file-position symbol) 1))
-        (:align t))))))
-
+    (let ((pos (ext:source-file-position symbol)))
+      `(((,symbol)
+         (:location
+           (:file ,(namestring (ext:source-pathname symbol)))
+           ,(if (and pos (plusp pos))
+                (list :position pos t)
+                (list :function-name (string symbol)))
+           (:align t)))))))
 
 (defimplementation find-definitions (symbol)
   (source-location symbol))




From sboukarev at common-lisp.net  Sun Sep 13 03:15:04 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sat, 12 Sep 2009 23:15:04 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MmfYO-0003md-5P@common-lisp.net>

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

Modified Files:
	ChangeLog slime-autodoc.el 
Log Message:
* contrib/slime-autodoc.el (slime-fontify-string): do not call
(slime-autodoc-mode -1), there is no reason to do so.
And it won't mess slime-echo-arglist-function, which fixes
bug reported by Stanislaw Halik.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/04 13:00:42	1.242
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/13 03:15:03	1.243
@@ -1,3 +1,10 @@
+2009-09-13  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-autodoc.el (slime-fontify-string): do not call
+	(slime-autodoc-mode -1), there is no reason to do so.
+	And it won't mess slime-echo-arglist-function, which fixes
+	bug reported by Stanislaw Halik.
+
 2009-09-04  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-repl.el (slime-sync-package-and-default-directory):
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/08/15 08:35:00	1.18
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/09/13 03:15:03	1.19
@@ -184,7 +184,6 @@
     (erase-buffer)
     (unless (eq major-mode 'lisp-mode)
       (lisp-mode)
-      (slime-autodoc-mode -1)
       (set (make-local-variable 'slime-highlight-suppressed-forms) nil))
     (insert string)
     (let ((font-lock-verbose nil))




From mevenson at common-lisp.net  Mon Sep 14 05:51:51 2009
From: mevenson at common-lisp.net (CVS User mevenson)
Date: Mon, 14 Sep 2009 01:51:51 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1Mn4Tf-0000ts-PO@common-lisp.net>

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

Modified Files:
	ChangeLog swank-abcl.lisp 
Log Message:
2009-09-14  Mark Evenson  <evenson at panix.com>

	* swank-abcl.lisp (source-location): Fix typo.


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/12 08:47:30	1.1852
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/14 05:51:51	1.1853
@@ -1,3 +1,7 @@
+2009-09-14  Mark Evenson  <evenson at panix.com>
+
+	* swank-abcl.lisp (source-location): Fix typo.
+
 2009-09-12  Mark Evenson  <evenson at panix.com>
 
 	Provided by Alan Ruttenberg.
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/09/12 08:47:30	1.69
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/09/14 05:51:51	1.70
@@ -440,7 +440,7 @@
          (:location
            (:file ,(namestring (ext:source-pathname symbol)))
            ,(if (and pos (plusp pos))
-                (list :position pos t)
+                (list :position pos)
                 (list :function-name (string symbol)))
            (:align t)))))))
 




From sboukarev at common-lisp.net  Tue Sep 15 17:34:33 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Tue, 15 Sep 2009 13:34:33 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MnbvF-0000AK-2r@common-lisp.net>

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

Modified Files:
	ChangeLog slime-autodoc.el 
Log Message:
* contrib/slime-autodoc.el (slime-fontify-string): setup *slime-fontify*
buffer without calling (lisp-mode) to avoid turning slime-mode there,
which may cause interference.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/13 03:15:03	1.243
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/15 17:34:32	1.244
@@ -1,3 +1,9 @@
+2009-09-15  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-autodoc.el (slime-fontify-string): setup *slime-fontify*
+	buffer without calling (lisp-mode) to avoid turning slime-mode there,
+	which may cause interference.
+
 2009-09-13  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-autodoc.el (slime-fontify-string): do not call
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/09/13 03:15:03	1.19
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/09/15 17:34:32	1.20
@@ -183,8 +183,10 @@
   (with-current-buffer (get-buffer-create " *slime-fontify*")
     (erase-buffer)
     (unless (eq major-mode 'lisp-mode)
-      (lisp-mode)
-      (set (make-local-variable 'slime-highlight-suppressed-forms) nil))
+      ;; Just calling (lisp-mode) will turn slime-mode on in that buffer,
+      ;; which may interfere with this function
+      (setq major-mode 'lisp-mode)
+      (lisp-mode-variables t))
     (insert string)
     (let ((font-lock-verbose nil))
       (font-lock-fontify-buffer))




From trittweiler at common-lisp.net  Tue Sep 15 22:30:13 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 15 Sep 2009 18:30:13 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MngXN-0003FS-W0@common-lisp.net>

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

Modified Files:
	ChangeLog slime-references.el 
Log Message:
	* slime-references.el: Largely refactored: decoupled code from
	SLDB; add references to the compilation log.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/15 17:34:32	1.244
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/15 22:30:13	1.245
@@ -1,3 +1,8 @@
+2009-09-16  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-references.el: Largely refactored: decoupled code from
+	SLDB; add references to the compilation log.
+
 2009-09-15  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-autodoc.el (slime-fontify-string): setup *slime-fontify*
--- /project/slime/cvsroot/slime/contrib/slime-references.el	2007/09/20 14:55:53	1.4
+++ /project/slime/cvsroot/slime/contrib/slime-references.el	2009/09/15 22:30:13	1.5
@@ -2,6 +2,7 @@
 ;;
 ;; Authors: Christophe Rhodes  <csr21 at cantab.net>
 ;;          Luke Gorrie  <luke at bluetail.com>
+;;          Tobias C. Rittweiler <tcr at freebits.de>
 ;;
 ;; License: GNU GPL (same license as Emacs)
 ;;
@@ -17,52 +18,16 @@
   "Face for references."
   :group 'slime-debugger)
 
-(defun slime-note.references (note)
-  (plist-get note :references))
-
-(defun slime-tree-print-with-references (tree)
-  ;; for SBCL-style references
-  (slime-tree-default-printer tree)
-  (when-let (note (plist-get (slime-tree.plist tree) 'note))
-    (when-let (references (slime-note.references note))
-      (terpri (current-buffer))
-      (princ "See also:" (current-buffer))
-      (terpri (current-buffer))
-      (slime-tree-insert-references references))))
-
-(defun slime-tree-insert-references (references)
-  "Insert documentation references from a condition.
-See SWANK-BACKEND:CONDITION-REFERENCES for the datatype."
-  (loop for refs on references
-        for ref = (car refs)
-        do
-        (destructuring-bind (where type what) ref
-          ;; FIXME: this is poorly factored, and shares some code and
-          ;; data with sldb that it shouldn't: notably
-          ;; sldb-reference-face.  Probably the names of
-          ;; sldb-reference-foo should be altered to be not sldb
-          ;; specific.
-          (insert "  " (sldb-format-reference-source where) ", ")
-          (slime-insert-propertized (sldb-reference-properties ref)
-                                    (sldb-format-reference-node what))
-          (insert (format " [%s]" type))
-          (when (cdr refs)
-            (terpri (current-buffer))))))
-
 
-;;;;; SLDB references (rather SBCL specific)
+;;;;; SBCL-style references 
 
-(defun sldb-insert-references (references)
-  "Insert documentation references from a condition.
-See SWANK-BACKEND:CONDITION-REFERENCES for the datatype."
-  (dolist (ref references)
-    (destructuring-bind (where type what) ref
-      (insert "\n" (sldb-format-reference-source where) ", ")
-      (slime-insert-propertized (sldb-reference-properties ref)
-				(sldb-format-reference-node what))
-      (insert (format " [%s]" type)))))
+(defvar slime-references-local-keymap
+  (let ((map (make-sparse-keymap "local keymap for slime references")))
+    (define-key map [mouse-2] 'slime-lookup-reference-at-mouse)
+    (define-key map [return] 'slime-lookup-reference-at-point)
+    map))
 
-(defun sldb-reference-properties (reference)
+(defun slime-reference-properties (reference)
   "Return the properties for a reference.
 Only add clickability to properties we actually know how to lookup."
   (destructuring-bind (where type what) reference
@@ -70,65 +35,115 @@
             (and (eq where :ansi-cl)
                  (memq type '(:function :special-operator :macro
 			      :section :glossary :issue))))
-        `(sldb-default-action
-          sldb-lookup-reference
-          ;; FIXME: this is a hack!  slime-compiler-notes and sldb are a
-          ;; little too intimately entwined.
-          slime-compiler-notes-default-action sldb-lookup-reference
-          sldb-reference ,reference
-          face sldb-reference-face
-          mouse-face highlight))))
+        `(slime-reference ,reference
+          font-lock-face sldb-reference-face
+          follow-link t
+          mouse-face highlight
+          help-echo "mouse-2: visit documentation."
+          keymap ,slime-references-local-keymap))))
+
+(defun slime-insert-reference (reference)
+  "Insert documentation reference from a condition.
+See SWANK-BACKEND:CONDITION-REFERENCES for the datatype."
+  (destructuring-bind (where type what) reference
+    (insert "\n" (slime-format-reference-source where) ", ")
+    (slime-insert-propertized (slime-reference-properties reference)
+                              (slime-format-reference-node what))
+    (insert (format " [%s]" type))))
+
+(defun slime-insert-references (references)
+  (when references
+    (insert "\nSee also:")
+    (slime-with-rigid-indentation 2
+      (mapc #'slime-insert-reference references))))
 
-(defun sldb-format-reference-source (where)
+(defun slime-format-reference-source (where)
   (case where
     (:amop    "The Art of the Metaobject Protocol")
     (:ansi-cl "Common Lisp Hyperspec")
     (:sbcl    "SBCL Manual")
     (t        (format "%S" where))))
 
-(defun sldb-format-reference-node (what)
+(defun slime-format-reference-node (what)
   (if (listp what)
       (mapconcat #'prin1-to-string what ".")
     what))
 
-(defun sldb-lookup-reference ()
+(defun slime-lookup-reference-at-point ()
   "Browse the documentation reference at point."
-  (destructuring-bind (where type what)
-      (get-text-property (point) 'sldb-reference)
-    (case where
-      (:ansi-cl
-       (case type
-         (:section
-          (browse-url (funcall common-lisp-hyperspec-section-fun what)))
-         (:glossary
-          (browse-url (funcall common-lisp-glossary-fun what)))
-         (:issue
-          (browse-url (funcall 'common-lisp-issuex what)))
-         (t
-          (hyperspec-lookup what))))
-      (t
-       (let ((url (format "%s%s.html" slime-sbcl-manual-root
-                          (subst-char-in-string ?\  ?\- what))))
-         (browse-url url))))))
+  (interactive)
+  (let ((refs (get-text-property (point) 'slime-reference)))
+    (if (null refs)
+        (error "No references at point")
+        (destructuring-bind (where type what) refs
+          (case where
+            (:ansi-cl
+               (case type
+                 (:section
+                    (browse-url (funcall common-lisp-hyperspec-section-fun what)))
+                 (:glossary
+                    (browse-url (funcall common-lisp-glossary-fun what)))
+                 (:issue
+                    (browse-url (funcall 'common-lisp-issuex what)))
+                 (t
+                    (hyperspec-lookup what))))
+            (t
+               (let ((url (format "%s%s.html" slime-sbcl-manual-root
+                                  (subst-char-in-string ?\  ?\- what))))
+                 (browse-url url))))))))
+
+(defun slime-lookup-reference-at-mouse (event)
+  "Invoke the action pointed at by the mouse."
+  (interactive "e")
+  (destructuring-bind (mouse-1 (w pos . _) . _) event
+    (save-excursion
+      (goto-char pos)
+      (slime-lookup-reference-at-point))))
+
+;;;;; Hook into *SLIME COMPILATION*
+
+(defun slime-note.references (note)
+  (plist-get note :references))
+
+;;; FIXME: `compilation-mode' will swallow the `mouse-face'
+;;; etc. properties.
+(defadvice slime-note.message (after slime-note.message+references)
+  (setq ad-return-value 
+        (concat ad-return-value
+                (with-temp-buffer
+                  (slime-insert-references 
+                   (slime-note.references (ad-get-arg 0)))
+                  (buffer-string)))))
+
+;;;;; Hook into slime-compiler-notes-tree
+
+(defun slime-tree-print-with-references (tree)
+  ;; for SBCL-style references
+  (slime-tree-default-printer tree)
+  (when-let (note (plist-get (slime-tree.plist tree) 'note))
+    (when-let (references (slime-note.references note))
+      (terpri (current-buffer))
+      (slime-insert-references references))))
+
+;;;;; Hook into SLDB
 
 (defun sldb-maybe-insert-references (extra)
   (destructure-case extra
-    ((:references references)
-     (when references
-       (insert "\nSee also:")
-       (slime-with-rigid-indentation 2
-	 (sldb-insert-references references)))
-     t)
+    ((:references references) (slime-insert-references references) t)
     (t nil)))
 
-
+
 ;;; Initialization
 
 (defun slime-references-init ()
+  (ad-enable-advice 'slime-note.message 'after 'slime-note.message+references)
+  (ad-activate 'slime-note.message)
   (setq slime-tree-printer 'slime-tree-print-with-references)
   (add-hook 'sldb-extras-hooks 'sldb-maybe-insert-references))
 
 (defun slime-references-unload ()
+  (ad-disable-advice 'slime-note.message 'after 'slime-note.message+references)
+  (ad-deactivate 'slime-note.message)
   (setq slime-tree-printer 'slime-tree-default-printer)
   (remove-hook 'sldb-extras-hooks 'sldb-maybe-insert-references))
   




From sboukarev at common-lisp.net  Wed Sep 16 15:46:27 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 16 Sep 2009 11:46:27 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MnwiB-0005rn-Fo@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
* swank.lisp (documentation-symbol): Return more readable information.


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/14 05:51:51	1.1853
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/16 15:46:27	1.1854
@@ -1,3 +1,7 @@
+2009-09-16  Stas Boukarev  <stassats at gmail.com>
+
+	* swank.lisp (documentation-symbol): Return more readable information.
+
 2009-09-14  Mark Evenson  <evenson at panix.com>
 
 	* swank-abcl.lisp (source-location): Fix typo.
--- /project/slime/cvsroot/slime/slime.el	2009/09/03 07:43:08	1.1220
+++ /project/slime/cvsroot/slime/slime.el	2009/09/16 15:46:27	1.1221
@@ -4696,7 +4696,7 @@
   (when (not symbol-name)
     (error "No symbol given"))
   (slime-eval-describe 
-   `(swank:documentation-symbol ,symbol-name "(not documented)")))
+   `(swank:documentation-symbol ,symbol-name)))
 
 (defun slime-describe-function (symbol-name)
   (interactive (list (slime-read-symbol-name "Describe symbol: ")))
--- /project/slime/cvsroot/slime/swank.lisp	2009/08/27 20:19:26	1.659
+++ /project/slime/cvsroot/slime/swank.lisp	2009/09/16 15:46:27	1.660
@@ -3116,19 +3116,21 @@
       (with-output-to-string (*standard-output*)
         (describe-definition (parse-symbol-or-lose name) kind)))))
 
-(defslimefun documentation-symbol (symbol-name &optional default)
+(defslimefun documentation-symbol (symbol-name)
   (with-buffer-syntax ()
     (multiple-value-bind (sym foundp) (parse-symbol symbol-name)
       (if foundp
           (let ((vdoc (documentation sym 'variable))
                 (fdoc (documentation sym 'function)))
-            (or (and (or vdoc fdoc)
-                     (concatenate 'string
-                                  fdoc
-                                  (and vdoc fdoc '(#\Newline #\Newline))
-                                  vdoc))
-                default))
-          default))))
+            (with-output-to-string (string)
+              (format string "Documentation for the symbol ~a:~2%" sym)
+              (unless (or vdoc fdoc)
+                (format string "Not documented." ))
+              (when vdoc
+                (format string "Variable:~% ~a~2%" vdoc))
+              (when fdoc
+                (format string "Function:~% ~a" fdoc))))
+          (format nil "No such symbol, ~a." symbol-name)))))
 
 
 ;;;; Package Commands




From mevenson at common-lisp.net  Thu Sep 17 06:23:03 2009
From: mevenson at common-lisp.net (CVS User mevenson)
Date: Thu, 17 Sep 2009 02:23:03 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MoAOV-0001aD-Hr@common-lisp.net>

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

Modified Files:
	ChangeLog swank-abcl.lisp 
Log Message:
* swank-abcl.lisp (source-location): Emacs buffers start at 1,
whereas CL files start at 0 (Tobias Rittweiler).


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/16 15:46:27	1.1854
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/17 06:23:03	1.1855
@@ -1,3 +1,8 @@
+2009-09-17  Mark Evenson  <evenson at panix.com>
+
+	* swank-abcl.lisp (source-location): Emacs buffers start at 1,
+	whereas CL files start at 0 (Tobias Rittweiler).
+
 2009-09-16  Stas Boukarev  <stassats at gmail.com>
 
 	* swank.lisp (documentation-symbol): Return more readable information.
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/09/14 05:51:51	1.70
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/09/17 06:23:03	1.71
@@ -439,8 +439,8 @@
       `(((,symbol)
          (:location
            (:file ,(namestring (ext:source-pathname symbol)))
-           ,(if (and pos (plusp pos))
-                (list :position pos)
+           ,(if pos
+                (list :position (1+ pos))
                 (list :function-name (string symbol)))
            (:align t)))))))
 




From sboukarev at common-lisp.net  Thu Sep 17 14:56:23 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Thu, 17 Sep 2009 10:56:23 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MoIPH-0006p6-4V@common-lisp.net>

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

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
* slime-repl.el (slime-repl-clear-buffer): Don't change cursor
position if is already at the prompt.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/15 22:30:13	1.245
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/17 14:56:22	1.246
@@ -1,3 +1,8 @@
+2009-09-17  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-repl.el (slime-repl-clear-buffer): Don't change cursor
+	position if is already at the prompt.
+
 2009-09-16  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-references.el: Largely refactored: decoupled code from
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/09/04 13:00:42	1.24
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/09/17 14:56:22	1.25
@@ -819,7 +819,8 @@
   (let ((inhibit-read-only t))
     (delete-region (point-min) slime-repl-prompt-start-mark)
     (delete-region slime-output-start slime-output-end)
-    (goto-char slime-repl-input-start-mark)
+    (when (< (point) slime-repl-input-start-mark)
+      (goto-char slime-repl-input-start-mark))
     (recenter t))
   (run-hooks 'slime-repl-clear-buffer-hook))
 




From trittweiler at common-lisp.net  Thu Sep 17 15:51:52 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Thu, 17 Sep 2009 11:51:52 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MoJGy-0002Ic-Fl@common-lisp.net>

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

Modified Files:
	swank-abcl.lisp ChangeLog 
Log Message:
	* swank-abcl.lisp (sys::break): Fix typo.
	(slot-definition-documentation, slot-definition-type)
	(class-prototype, generic-function-declarations)
	(specializers-direct-methods, slot-boundp-using-class)
	(slot-value-using-class): Add IGNORE declarations. Compiling
	swank-abcl.lisp is now free of warnings.
	(swank-compile-file): Load the compiled file even though warnings
	were signalled during compilation.


--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/09/17 06:23:03	1.71
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/09/17 15:51:52	1.72
@@ -16,7 +16,7 @@
 
 (defun sys::break (&optional (format-control "BREAK called") 
                    &rest format-arguments)
-  (let ((*saved-backtrace* 
+  (let ((sys::*saved-backtrace* 
          #+#.(swank-backend::with-symbol 'backtrace 'sys) 
          (sys:backtrace)
          #-#.(swank-backend::with-symbol 'backtrace 'sys)
@@ -47,11 +47,24 @@
 
 ;(defun class-finalized-p (class) t)
 
-(defun slot-definition-documentation (slot) #+nil (documentation slot 't))
-(defun slot-definition-type (slot) t)
-(defun class-prototype (class))
-(defun generic-function-declarations (gf))
-(defun specializer-direct-methods (spec) (mop::class-direct-methods spec))
+(defun slot-definition-documentation (slot)
+  (declare (ignore slot))
+  #+nil (documentation slot 't))
+
+(defun slot-definition-type (slot)
+  (declare (ignore slot))
+  t)
+
+(defun class-prototype (class)
+  (declare (ignore class))
+  nil)
+
+(defun generic-function-declarations (gf)
+  (declare (ignore gf))
+  nil)
+
+(defun specializer-direct-methods (spec)
+  (mop::class-direct-methods spec))
 
 (defun slot-definition-name (slot)
   (mop::%slot-definition-name slot))
@@ -66,9 +79,11 @@
   (mop::%method-function method))
 
 (defun slot-boundp-using-class (class object slotdef)
+  (declare (ignore class))
   (system::slot-boundp object (slot-definition-name slotdef)))
 
 (defun slot-value-using-class (class object slotdef)
+  (declare (ignore class))
   (system::slot-value object (slot-definition-name slotdef)))
 
 (import-to-swank-mop
@@ -281,7 +296,7 @@
           (second (member magic-token (ext:backtrace-as-list)
                           :key #'(lambda (frame) 
                                    (first frame))))
-          ))
+          ))    
     (funcall debugger-loop-fn)))
 
 (defun backtrace (start end)
@@ -389,9 +404,8 @@
         (multiple-value-bind (fn warn fail) 
             (compile-file input-file :output-file output-file)
           (values fn warn
-                  (or fail 
-                      (and load-p 
-                           (not (load fn))))))))))
+                  (and fn load-p
+                       (not (load fn)))))))))
 
 (defimplementation swank-compile-string (string &key buffer position filename
                                          policy)
--- /project/slime/cvsroot/slime/ChangeLog	2009/09/17 06:23:03	1.1855
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/17 15:51:52	1.1856
@@ -1,3 +1,14 @@
+2009-09-17  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank-abcl.lisp (sys::break): Fix typo.
+	(slot-definition-documentation, slot-definition-type)
+	(class-prototype, generic-function-declarations)
+	(specializers-direct-methods, slot-boundp-using-class)
+	(slot-value-using-class): Add IGNORE declarations. Compiling
+	swank-abcl.lisp is now free of warnings.
+	(swank-compile-file): Load the compiled file even though warnings
+	were signalled during compilation.
+
 2009-09-17  Mark Evenson  <evenson at panix.com>
 
 	* swank-abcl.lisp (source-location): Emacs buffers start at 1,




From trittweiler at common-lisp.net  Fri Sep 18 21:09:40 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 18 Sep 2009 17:09:40 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1Moki4-000614-RK@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
	New binding: M-_ (`slime-edit-callers').

	Similiar to `slime-who-calls' but only creates an Xref buffer if
	needed for disambiguation, and also pushes to the definition
	stack.

	Spiritually like M-. but works "in the other direction".

	* slime.el (sllime-edit-callers): New function. Cross between
	`slime-who-calls' and `slime-edit-definition'.
	(slime-parent-bindings): Define M-_ as `slime-edit-callers'.
	(slime-pop-xref-buffer): New helper. Extracted from
	`slime-show-xrefs'.
	(slime-show-xrefs): Use it.
	(slime-xref): Let callers specify a continuation.


--- /project/slime/cvsroot/slime/slime.el	2009/09/16 15:46:27	1.1221
+++ /project/slime/cvsroot/slime/slime.el	2009/09/18 21:09:40	1.1222
@@ -538,6 +538,7 @@
 (defvar slime-parent-bindings
   '(("\M-."      slime-edit-definition)
     ("\M-,"      slime-pop-find-definition-stack)
+    ("\M-_"      slime-edit-callers)
     ("\C-x4." 	 slime-edit-definition-other-window)
     ("\C-x5." 	 slime-edit-definition-other-frame)
     ("\C-x\C-e"  slime-eval-last-expression)
@@ -4023,6 +4024,24 @@
            (slime-show-xrefs file-alist 'definition name
                              (slime-current-package))))))
 
+(defun slime-edit-callers (symbol)
+  "Quite similiar to `slime-who-calls' but only shows Xref buffer
+if needed for disambiguation. Also pushes onto the definition
+stack."
+  (interactive (list (slime-read-symbol-name "Edit callers of: ")))
+  (slime-xref :calls symbol 
+    #'(lambda (xrefs type symbol package snapshot)
+        (cond ((null xrefs)
+               (message "No xref information found for %s." symbol))
+              ((and (slime-length= xrefs 1)         ; one group
+                    (slime-length= (cdr xrefs) 1))  ; one ref in group
+               (destructuring-bind (_ . (_ loc)) (first xrefs)
+                 (slime-push-definition-stack)
+                 (slime-pop-to-location loc)))
+              (t
+               (slime-push-definition-stack)
+               (slime-pop-xref-buffer xrefs type symbol package snapshot))))))
+
 (defun slime-analyze-xrefs (xrefs)
   "Find common filenames in XREFS.
 Return a list (SINGLE-LOCATION FILE-ALIST).
@@ -4883,6 +4902,15 @@
   ;; Remove the final newline to prevent accidental window-scrolling
   (backward-delete-char 1))
 
+(defun slime-pop-xref-buffer (xrefs type symbol package emacs-snapshot)
+  (slime-with-xref-buffer (type symbol package emacs-snapshot)
+    (slime-insert-xrefs xrefs)
+    (goto-char (point-min))
+    (forward-line)
+    (skip-chars-forward " \t")
+    (setq slime-next-location-function 'slime-goto-next-xref)
+    (setq slime-xref-last-buffer (current-buffer ))))
+
 (defvar slime-next-location-function nil
   "Function to call for going to the next location.")
 
@@ -4894,13 +4922,7 @@
   "Show the results of an XREF query."
   (if (null xrefs)
       (message "No references found for %s." symbol)
-    (slime-with-xref-buffer (type symbol package emacs-snapshot)
-      (slime-insert-xrefs xrefs)
-      (goto-char (point-min))
-      (forward-line)
-      (skip-chars-forward " \t")
-      (setq slime-next-location-function 'slime-goto-next-xref)
-      (setq slime-xref-last-buffer (current-buffer )))))
+      (slime-pop-xref-buffer xrefs type symbol package emacs-snapshot)))
 
 
 ;;;;; XREF commands
@@ -4950,15 +4972,19 @@
   (interactive (list (slime-read-symbol-name "List callees: ")))
   (slime-xref :callees symbol-name))
 
-(defun slime-xref (type symbol)
+(defun slime-xref (type symbol &optional continuation)
   "Make an XREF request to Lisp."
   (slime-eval-async
    `(swank:xref ',type ',symbol)
-   (slime-rcurry
-    (lambda (result type symbol package snapshot)
-      (let ((file-alist (cadr (slime-analyze-xrefs result))))
-         (slime-show-xrefs file-alist type symbol package snapshot)))
-    type symbol (slime-current-package) (slime-current-emacs-snapshot))))
+   (slime-rcurry (lexical-let ((cont continuation))
+                   (lambda (result type symbol package snapshot)
+                     (let ((file-alist (cadr (slime-analyze-xrefs result))))
+                       (funcall (or cont 'slime-show-xrefs)
+                                file-alist type symbol package snapshot))))
+                 type 
+                 symbol 
+                 (slime-current-package)
+                 (slime-current-emacs-snapshot))))
 
 
 ;;;;; XREF navigation
--- /project/slime/cvsroot/slime/ChangeLog	2009/09/17 15:51:52	1.1856
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/18 21:09:40	1.1857
@@ -1,3 +1,21 @@
+2009-09-18  Tobias C. Rittweiler <tcr at freebits.de>
+
+	New binding: M-_ (`slime-edit-callers').
+
+	Similiar to `slime-who-calls' but only creates an Xref buffer if
+	needed for disambiguation, and also pushes to the definition
+	stack.
+
+	Spiritually like M-. but works "in the other direction".
+
+	* slime.el (sllime-edit-callers): New function. Cross between
+	`slime-who-calls' and `slime-edit-definition'.
+	(slime-parent-bindings): Define M-_ as `slime-edit-callers'.
+	(slime-pop-xref-buffer): New helper. Extracted from
+	`slime-show-xrefs'.
+	(slime-show-xrefs): Use it.
+	(slime-xref): Let callers specify a continuation.
+
 2009-09-17  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* swank-abcl.lisp (sys::break): Fix typo.




From trittweiler at common-lisp.net  Fri Sep 18 21:29:59 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 18 Sep 2009 17:29:59 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1Mol1j-00073K-Nu@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
	* slime.el (slime-parent-bindings): Define M-? as
	`slime-edit-callers', too. My previous choice of M-_ was
	warped due to my German layout.


--- /project/slime/cvsroot/slime/slime.el	2009/09/18 21:09:40	1.1222
+++ /project/slime/cvsroot/slime/slime.el	2009/09/18 21:29:59	1.1223
@@ -538,7 +538,8 @@
 (defvar slime-parent-bindings
   '(("\M-."      slime-edit-definition)
     ("\M-,"      slime-pop-find-definition-stack)
-    ("\M-_"      slime-edit-callers)
+    ("\M-_"      slime-edit-callers)    ; for German layout
+    ("\M-?"      slime-edit-callers)    ; for USian layout
     ("\C-x4." 	 slime-edit-definition-other-window)
     ("\C-x5." 	 slime-edit-definition-other-frame)
     ("\C-x\C-e"  slime-eval-last-expression)
--- /project/slime/cvsroot/slime/ChangeLog	2009/09/18 21:09:40	1.1857
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/18 21:29:59	1.1858
@@ -1,5 +1,11 @@
 2009-09-18  Tobias C. Rittweiler <tcr at freebits.de>
 
+	* slime.el (slime-parent-bindings): Define M-? as
+	`slime-edit-callers', too. My previous choice of M-_ was warped
+	due to my German layout.
+
+2009-09-18  Tobias C. Rittweiler <tcr at freebits.de>
+
 	New binding: M-_ (`slime-edit-callers').
 
 	Similiar to `slime-who-calls' but only creates an Xref buffer if




From mevenson at common-lisp.net  Sun Sep 20 09:04:54 2009
From: mevenson at common-lisp.net (CVS User mevenson)
Date: Sun, 20 Sep 2009 05:04:54 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MpILm-00062s-27@common-lisp.net>

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

Modified Files:
	ChangeLog swank-abcl.lisp 
Log Message:
Use *INVOKE-DEBUGGER-HOOK* introduced in ABCL by analogy to SBCL (Tobias Rittweiler).


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/18 21:29:59	1.1858
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/20 09:04:53	1.1859
@@ -1,3 +1,11 @@
+2009-09-20  Mark Evenson  <evenson at panix.com>
+
+	Use *INVOKE-DEBUGGER-HOOK* introduced in ABCL by analogy to SBCL
+	 (Tobias Rittweiler).
+
+	* swank-abcl.lisp (sys::break): Conditionally redefine SYS::BREAK
+	only if SYS::INVOKE-DEUBBGER-HOOK is not present.
+
 2009-09-18  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* slime.el (slime-parent-bindings): Define M-? as
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/09/17 15:51:52	1.72
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/09/20 09:04:53	1.73
@@ -14,6 +14,10 @@
   (require :collect) ;just so that it doesn't spoil the flying letters
   (require :pprint))
 
+;;; The introduction of SYS::*INVOKE-DEBUGGER-HOOK* obliterates the
+;;; need for redefining BREAK. The following should thus be removed at
+;;; some point in the future.
+#-#.(swank-backend::with-symbol '*invoke-debugger-hook* 'sys)
 (defun sys::break (&optional (format-control "BREAK called") 
                    &rest format-arguments)
   (let ((sys::*saved-backtrace* 
@@ -283,6 +287,28 @@
 
 ;;;; Debugger
 
+;;; Copied from swank-sbcl.lisp.
+(defun make-invoke-debugger-hook (hook)
+  #'(lambda (condition old-hook)
+      ;; Notice that *INVOKE-DEBUGGER-HOOK* is tried before
+      ;; *DEBUGGER-HOOK*, so we have to make sure that the latter gets
+      ;; run when it was established locally by a user (i.e. changed
+      ;; meanwhile.)
+      (if *debugger-hook*
+          (funcall *debugger-hook* condition old-hook)
+          (funcall hook condition old-hook))))
+
+(defimplementation call-with-debugger-hook (hook fun)
+  (let ((*debugger-hook* hook)
+        #+#.(swank-backend::with-symbol '*invoke-debugger-hook* 'sys)
+        (sys::*invoke-debugger-hook* (make-invoke-debugger-hook hook)))
+    (funcall fun)))
+
+(defimplementation install-debugger-globally (function)
+  (setq *debugger-hook* function)
+  #+#.(swank-backend::with-symbol '*invoke-debugger-hook* 'sys)
+  (setq sys::*invoke-debugger-hook* (make-invoke-debugger-hook function)))
+
 (defvar *sldb-topframe*)
 
 (defimplementation call-with-debugging-environment (debugger-loop-fn)




From trittweiler at common-lisp.net  Sun Sep 20 09:39:16 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sun, 20 Sep 2009 05:39:16 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MpIt2-0007ur-Ex@common-lisp.net>

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

Modified Files:
	swank.lisp swank-backend.lisp slime.el ChangeLog 
Log Message:
	Generalize M-? (or M-_ respectively.)

	It will now list:

	  - call sites for functions,

	  - macroexpand sites for macros,

	  - binding, setting, referencing sites for variables,

	  - specializing methods for classes.

	* slime.el (slime-xref): Deal with :not-implemented.
	(slime-xrefs): New. Makes RPC request to XREFS.
	(slime-edit-callers): Renamed to `slime-edit-uses'.
	(slime-edit-uses): Use slime-xrefs.

	* swank-backend.lisp (who-*): Add default implementation which
	returns :not-implemented.

	* swank.lisp (xref-doit): Extracted from XREF.
	(xref): Pass over :not-implemented to Emacs side.
	(xrefs): New slime fun. To return results of multiple XREF
	requests at once.


--- /project/slime/cvsroot/slime/swank.lisp	2009/09/16 15:46:27	1.660
+++ /project/slime/cvsroot/slime/swank.lisp	2009/09/20 09:39:16	1.661
@@ -3235,19 +3235,32 @@
     (unless error
       (mapcar #'xref>elisp (find-definitions sexp)))))
 
+(defun xref-doit (type symbol)
+  (ecase type
+    (:calls (who-calls symbol))
+    (:calls-who (calls-who symbol))
+    (:references (who-references symbol))
+    (:binds (who-binds symbol))
+    (:sets (who-sets symbol))
+    (:macroexpands (who-macroexpands symbol))
+    (:specializes (who-specializes symbol))
+    (:callers (list-callers symbol))
+    (:callees (list-callees symbol))))
+
 (defslimefun xref (type name)
-  (let ((symbol (parse-symbol-or-lose name *buffer-package*)))
-    (mapcar #'xref>elisp
-            (ecase type
-              (:calls (who-calls symbol))
-              (:calls-who (calls-who symbol))
-              (:references (who-references symbol))
-              (:binds (who-binds symbol))
-              (:sets (who-sets symbol))
-              (:macroexpands (who-macroexpands symbol))
-              (:specializes (who-specializes symbol))
-              (:callers (list-callers symbol))
-              (:callees (list-callees symbol))))))
+  (with-buffer-syntax ()
+    (let* ((symbol (parse-symbol-or-lose name))
+           (xrefs  (xref-doit type symbol)))
+      (if (eq xrefs :not-implemented)
+          :not-implemented
+          (mapcar #'xref>elisp xrefs)))))
+
+(defslimefun xrefs (types name)
+  (loop for type in types
+        for xrefs = (xref type name)
+        when (and (not (eq :not-implemented xrefs))
+                  (not (null xrefs)))
+          collect (cons type xrefs)))
 
 (defun xref>elisp (xref)
   (destructuring-bind (name loc) xref
--- /project/slime/cvsroot/slime/swank-backend.lisp	2009/08/10 19:30:22	1.180
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2009/09/20 09:39:16	1.181
@@ -639,7 +639,7 @@
 to safe reader/printer settings, and so on.")
 
 (definterface call-with-debugger-hook (hook fun)
-  "Call FUN and use HOOK as debugger hook.
+  "Call FUN and use HOOK as debugger hook. HOOK can be NIL.
 
 HOOK should be called for both BREAK and INVOKE-DEBUGGER."
   (let ((*debugger-hook* hook))
@@ -829,31 +829,45 @@
 
 (definterface who-calls (function-name)
   "Return the call sites of FUNCTION-NAME (a symbol).
-The results is a list ((DSPEC LOCATION) ...).")
+The results is a list ((DSPEC LOCATION) ...)."
+  (declare (ignore function-name))
+  :not-implemented)
 
 (definterface calls-who (function-name)
   "Return the call sites of FUNCTION-NAME (a symbol).
-The results is a list ((DSPEC LOCATION) ...).")
+The results is a list ((DSPEC LOCATION) ...)."
+  (declare (ignore function-name))
+  :not-implemented)
 
 (definterface who-references (variable-name)
   "Return the locations where VARIABLE-NAME (a symbol) is referenced.
-See WHO-CALLS for a description of the return value.")
+See WHO-CALLS for a description of the return value."
+  (declare (ignore variable-name))
+  :not-implemented)
 
 (definterface who-binds (variable-name)
   "Return the locations where VARIABLE-NAME (a symbol) is bound.
-See WHO-CALLS for a description of the return value.")
+See WHO-CALLS for a description of the return value."
+  (declare (ignore variable-name))
+  :not-implemented)
 
 (definterface who-sets (variable-name)
   "Return the locations where VARIABLE-NAME (a symbol) is set.
-See WHO-CALLS for a description of the return value.")
+See WHO-CALLS for a description of the return value."
+  (declare (ignore variable-name))
+  :not-implemented)
 
 (definterface who-macroexpands (macro-name)
   "Return the locations where MACRO-NAME (a symbol) is expanded.
-See WHO-CALLS for a description of the return value.")
+See WHO-CALLS for a description of the return value."
+  (declare (ignore macro-name))
+  :not-implemented)
 
 (definterface who-specializes (class-name)
   "Return the locations where CLASS-NAME (a symbol) is specialized.
-See WHO-CALLS for a description of the return value.")
+See WHO-CALLS for a description of the return value."
+  (declare (ignore class-name))
+  :not-implemented)
 
 ;;; Simpler variants.
 
--- /project/slime/cvsroot/slime/slime.el	2009/09/18 21:29:59	1.1223
+++ /project/slime/cvsroot/slime/slime.el	2009/09/20 09:39:16	1.1224
@@ -538,8 +538,8 @@
 (defvar slime-parent-bindings
   '(("\M-."      slime-edit-definition)
     ("\M-,"      slime-pop-find-definition-stack)
-    ("\M-_"      slime-edit-callers)    ; for German layout
-    ("\M-?"      slime-edit-callers)    ; for USian layout
+    ("\M-_"      slime-edit-uses)    ; for German layout
+    ("\M-?"      slime-edit-uses)    ; for USian layout
     ("\C-x4." 	 slime-edit-definition-other-window)
     ("\C-x5." 	 slime-edit-definition-other-frame)
     ("\C-x\C-e"  slime-eval-last-expression)
@@ -2872,30 +2872,9 @@
       (setf (getf new-note :severity) new-severity)
       new-note)))
 
-;; XXX: unused function
-(defun slime-intersperse (element list)
-  "Intersperse ELEMENT between each element of LIST."
-  (if (null list) 
-      '()
-    (cons (car list)
-          (mapcan (lambda (x) (list element x)) (cdr list)))))
-
 (defun slime-notes-in-same-location-p (a b)
   (equal (slime-note.location a) (slime-note.location b)))
 
-(defun slime-group-similar (similar-p list)
-  "Return the list of lists of 'similar' adjacent elements of LIST.
-The function SIMILAR-P is used to test for similarity.
-The order of the input list is preserved."
-  (if (null list)
-      nil
-    (let ((accumulator (list (list (car list)))))
-      (dolist (x (cdr list))
-        (if (funcall similar-p x (caar accumulator))
-            (push x (car accumulator))
-          (push (list x) accumulator)))
-      (reverse (mapcar #'reverse accumulator)))))
-
 
 ;;;;; Compiler notes list
 
@@ -3069,22 +3048,6 @@
                                  (t (< col1 col2)))))))))
             locs)))
 
-(defun slime-alistify (list key test)
-  "Partition the elements of LIST into an alist.
-KEY extracts the key from an element and TEST is used to compare
-keys."
-  (declare (type function key))
-  (let ((alist '()))
-    (dolist (e list)
-      (let* ((k (funcall key e))
-	     (probe (assoc* k alist :test test)))
-	(if probe
-	    (push e (cdr probe))
-            (push (cons k (list e)) alist))))
-    ;; Put them back in order.
-    (loop for (key . value) in (reverse alist)
-          collect (cons key (reverse value)))))
-
 (defun slime-note.severity (note)
   (plist-get note :severity))
 
@@ -4004,7 +3967,7 @@
   "Lookup the definition of the name at point.  
 If there's no name at point, or a prefix argument is given, then the
 function name is prompted."
-  (interactive (list (slime-read-symbol-name "Name: ")))
+  (interactive (list (slime-read-symbol-name "Edit Definition of: ")))
   (or (run-hook-with-args-until-success 'slime-edit-definition-hooks 
                                         name where)
       (slime-edit-definition-cont (slime-find-definitions name)
@@ -4025,23 +3988,28 @@
            (slime-show-xrefs file-alist 'definition name
                              (slime-current-package))))))
 
-(defun slime-edit-callers (symbol)
-  "Quite similiar to `slime-who-calls' but only shows Xref buffer
-if needed for disambiguation. Also pushes onto the definition
-stack."
-  (interactive (list (slime-read-symbol-name "Edit callers of: ")))
-  (slime-xref :calls symbol 
-    #'(lambda (xrefs type symbol package snapshot)
-        (cond ((null xrefs)
-               (message "No xref information found for %s." symbol))
-              ((and (slime-length= xrefs 1)         ; one group
-                    (slime-length= (cdr xrefs) 1))  ; one ref in group
-               (destructuring-bind (_ . (_ loc)) (first xrefs)
-                 (slime-push-definition-stack)
-                 (slime-pop-to-location loc)))
-              (t
-               (slime-push-definition-stack)
-               (slime-pop-xref-buffer xrefs type symbol package snapshot))))))
+;;; FIXME. TODO: Would be nice to group the symbols (in each
+;;;              type-group) by their home-package.
+(defun slime-edit-uses (symbol)
+  "Lookup all the uses of SYMBOL."
+  (interactive (list (slime-read-symbol-name "Edit Uses of: ")))
+  (slime-xrefs '(:calls :macroexpands
+                 :binds :references :sets
+                 :specializes) 
+               symbol
+               #'(lambda (xrefs type symbol package snapshot)
+                   (cond 
+                     ((null xrefs)
+                      (message "No xref information found for %s." symbol))
+                     ((and (slime-length= xrefs 1)          ; one group
+                           (slime-length= (cdar  xrefs) 1)) ; one ref in group
+                      (destructuring-bind (_ (_ loc)) (first xrefs)
+                        (slime-push-definition-stack)
+                        (slime-pop-to-location loc)))
+                     (t
+                      (slime-push-definition-stack)
+                      (slime-show-xref-buffer xrefs type symbol 
+                                              package snapshot))))))
 
 (defun slime-analyze-xrefs (xrefs)
   "Find common filenames in XREFS.
@@ -4903,7 +4871,7 @@
   ;; Remove the final newline to prevent accidental window-scrolling
   (backward-delete-char 1))
 
-(defun slime-pop-xref-buffer (xrefs type symbol package emacs-snapshot)
+(defun slime-show-xref-buffer (xrefs type symbol package emacs-snapshot)
   (slime-with-xref-buffer (type symbol package emacs-snapshot)
     (slime-insert-xrefs xrefs)
     (goto-char (point-min))
@@ -4923,7 +4891,7 @@
   "Show the results of an XREF query."
   (if (null xrefs)
       (message "No references found for %s." symbol)
-      (slime-pop-xref-buffer xrefs type symbol package emacs-snapshot)))
+      (slime-show-xref-buffer xrefs type symbol package emacs-snapshot)))
 
 
 ;;;;; XREF commands
@@ -4977,15 +4945,41 @@
   "Make an XREF request to Lisp."
   (slime-eval-async
    `(swank:xref ',type ',symbol)
-   (slime-rcurry (lexical-let ((cont continuation))
-                   (lambda (result type symbol package snapshot)
-                     (let ((file-alist (cadr (slime-analyze-xrefs result))))
-                       (funcall (or cont 'slime-show-xrefs)
-                                file-alist type symbol package snapshot))))
+   (slime-rcurry (lambda (result type symbol package snapshot cont)
+                   (slime-check-xref-implemented type result)
+                   (let ((file-alist (cadr (slime-analyze-xrefs result))))
+                     (funcall (or cont 'slime-show-xrefs)
+                              file-alist type symbol package snapshot)))
                  type 
                  symbol 
                  (slime-current-package)
-                 (slime-current-emacs-snapshot))))
+                 (slime-current-emacs-snapshot)
+                 continuation)))
+
+(defun slime-check-xref-implemented (type xrefs)
+  (when (eq xrefs :not-implemented)
+    (error "%s is not implemented yet on %s." 
+           (slime-xref-type type)
+           (slime-lisp-implementation-name))))
+
+(defun slime-xref-type (type)
+  (format "who-%s" (slime-cl-symbol-name type)))
+
+(defun slime-xrefs (types symbol &optional continuation)
+  "Make multiple XREF requests at once."
+  (slime-eval-async
+   `(swank:xrefs ',types ',symbol)
+   (slime-rcurry (lambda (result types symbol package snapshot cont)
+                   (funcall (or cont 'slime-show-xrefs)
+                            (slime-map-alist #'slime-xref-type 
+                                             #'identity 
+                                             result)
+                            types symbol package snapshot))
+                 types 
+                 symbol 
+                 (slime-current-package)
+                 (slime-current-emacs-snapshot)
+                 continuation)))
 
 
 ;;;;; XREF navigation
@@ -8269,6 +8263,55 @@
 
 ;;;; Utilities
 
+;;;; List frobbing
+
+(defun slime-map-alist (car-fn cdr-fn alist)
+  "Map over ALIST, calling CAR-FN on the car, and CDR-FN on the
+cdr of each entry."
+  (mapcar #'(lambda (entry)
+              (cons (funcall car-fn (car entry))
+                    (funcall cdr-fn (cdr entry))))
+          alist))
+
+;; XXX: unused function
+(defun slime-intersperse (element list)
+  "Intersperse ELEMENT between each element of LIST."
+  (if (null list) 
+      '()
+    (cons (car list)
+          (mapcan (lambda (x) (list element x)) (cdr list)))))
+
+;;; FIXME: this looks almost slime `slime-alistify', perhaps the two
+;;;        functions can be merged.
+(defun slime-group-similar (similar-p list)
+  "Return the list of lists of 'similar' adjacent elements of LIST.
+The function SIMILAR-P is used to test for similarity.
+The order of the input list is preserved."
+  (if (null list)
+      nil
+    (let ((accumulator (list (list (car list)))))
+      (dolist (x (cdr list))
+        (if (funcall similar-p x (caar accumulator))
+            (push x (car accumulator))
+          (push (list x) accumulator)))
+      (reverse (mapcar #'reverse accumulator)))))
+
+(defun slime-alistify (list key test)
+  "Partition the elements of LIST into an alist.
+KEY extracts the key from an element and TEST is used to compare
+keys."
+  (declare (type function key))
+  (let ((alist '()))
+    (dolist (e list)
+      (let* ((k (funcall key e))
+	     (probe (assoc* k alist :test test)))
+	(if probe
+	    (push e (cdr probe))
+            (push (cons k (list e)) alist))))
+    ;; Put them back in order.
+    (loop for (key . value) in (reverse alist)
+          collect (cons key (reverse value)))))
+
 ;;;;; Misc.
 
 (defun slime-length= (seq n)
--- /project/slime/cvsroot/slime/ChangeLog	2009/09/20 09:04:53	1.1859
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/20 09:39:16	1.1860
@@ -1,3 +1,30 @@
+2009-09-20  Tobias C. Rittweiler <tcr at freebits.de>
+
+	Generalize M-? (or M-_ respectively.)
+
+	It will now list:
+
+	  - call sites for functions,
+
+	  - macroexpand sites for macros,
+
+	  - binding, setting, referencing sites for variables,
+
+	  - specializing methods for classes.
+
+	* slime.el (slime-xref): Deal with :not-implemented.
+	(slime-xrefs): New. Makes RPC request to XREFS.
+	(slime-edit-callers): Renamed to `slime-edit-uses'.
+	(slime-edit-uses): Use slime-xrefs.
+
+	* swank-backend.lisp (who-*): Add default implementation which
+	returns :not-implemented.
+
+	* swank.lisp (xref-doit): Extracted from XREF.
+	(xref): Pass over :not-implemented to Emacs side.
+	(xrefs): New slime fun. To return results of multiple XREF
+	requests at once.
+
 2009-09-20  Mark Evenson  <evenson at panix.com>
 
 	Use *INVOKE-DEBUGGER-HOOK* introduced in ABCL by analogy to SBCL




From trittweiler at common-lisp.net  Sun Sep 20 10:51:50 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sun, 20 Sep 2009 06:51:50 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MpK1G-00055Y-KM@common-lisp.net>

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

Modified Files:
	swank-abcl.lisp ChangeLog 
Log Message:
	* swank-abcl.lisp (thread-description): Fix typo.
	(set-thread-description): Ditto.


--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/09/20 09:04:53	1.73
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/09/20 10:51:50	1.74
@@ -344,7 +344,7 @@
     (backtrace start end)))
 
 (defimplementation print-frame (frame stream)
-  (write-string 
+  (write-string
    #+#.(swank-backend::with-symbol 'backtrace 'sys)
    (sys:frame-to-string frame)
    #-#.(swank-backend::with-symbol 'backtrace 'sys)
@@ -589,12 +589,12 @@
   (defparameter *thread-description-map* (make-hash-table)) 
 
   (defimplementation thread-description (thread) 
-    (synchronized-on *thread-description-map*
+    (threads:synchronized-on *thread-description-map*
       (or (gethash thread *thread-description-map*)
-          "No description available.")))
+          "")))
 
   (defimplementation set-thread-description (thread description) 
-    (synchronized-on *thread-description-map*
+    (threads:synchronized-on *thread-description-map*
       (setf (gethash thread *thread-description-map*) description)))
 
   (defimplementation make-lock (&key name)
--- /project/slime/cvsroot/slime/ChangeLog	2009/09/20 09:39:16	1.1860
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/20 10:51:50	1.1861
@@ -1,5 +1,10 @@
 2009-09-20  Tobias C. Rittweiler <tcr at freebits.de>
 
+	* swank-abcl.lisp (thread-description): Fix typo.
+	(set-thread-description): Ditto.
+
+2009-09-20  Tobias C. Rittweiler <tcr at freebits.de>
+
 	Generalize M-? (or M-_ respectively.)
 
 	It will now list:




From sboukarev at common-lisp.net  Mon Sep 21 19:08:29 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 21 Sep 2009 15:08:29 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MpoFR-00077H-Ck@common-lisp.net>

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

Modified Files:
	ChangeLog 
Added Files:
	slime-sprof.el swank-sprof.lisp 
Log Message:
* contrib/{slime-sprof.el, swank-sprof.lisp}: New contrib for
integration with SBCL's sb-sprof profiler,
adopted from Juho Snellman's code.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/17 14:56:22	1.246
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/21 19:08:28	1.247
@@ -1,3 +1,9 @@
+2009-09-21  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-sprof.el, swank-sprof.lisp: New contrib for
+	integration with SBCL's sb-sprof profiler,
+	adopted from Juho Snellman's code.
+
 2009-09-17  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-repl.el (slime-repl-clear-buffer): Don't change cursor

--- /project/slime/cvsroot/slime/contrib/slime-sprof.el	2009/09/21 19:08:29	NONE
+++ /project/slime/cvsroot/slime/contrib/slime-sprof.el	2009/09/21 19:08:29	1.1
;;; slime-sprof.el --- Integration with SBCL's sb-sprof
;;;
;;; Authors: Juho Snellman
;;;
;;; License: MIT
;;;
;;; Installation
;;
;; Add this to your .emacs: 
;;
;;   (slime-setup '(... slime-sprof))

(slime-require :swank-sprof)

(define-derived-mode slime-sprof-browser-mode fundamental-mode
  "slprof"
  "Mode for browsing profiler data\
\\<slime-sprof-browser-mode-map>\
\\{slime-sprof-browser-mode-map}"
  (setq buffer-read-only t)
  (let ((inhibit-read-only t))
    (erase-buffer)
    (insert (format "%4s %-54s %6s %6s %6s\n"
                    "Rank"
                    "Name"
                    "Self%"
                    "Cumul%"
                    "Total%"))
    (dolist (data graph)
      (slime-sprof-browser-insert-line data 54)))
  (goto-line 2))

(slime-define-keys slime-sprof-browser-mode-map
  ("h" 'describe-mode)
  ("q" 'bury-buffer)
  ("d" 'slime-sprof-browser-disassemble-function)
  ("g" 'slime-sprof-browser-go-to)
  ("v" 'slime-sprof-browser-view-source)
  ((kbd "RET") 'slime-sprof-browser-toggle))

;; Start / stop profiling

(defun slime-sprof-start ()
  (interactive)
  (slime-eval `(swank:swank-sprof-start)))

(defun slime-sprof-stop ()
  (interactive)
  (slime-eval `(swank:swank-sprof-stop)))

;; Reporting

(defun slime-sprof-browser ()
  (interactive)
  (lexical-let ((buffer (slime-sprof-browser-get-buffer)))
    (slime-eval-async `(swank:swank-sprof-get-call-graph)
                      (lambda (graph)
                        (with-current-buffer buffer
                          (switch-to-buffer buffer)
                          (slime-sprof-browser-mode))))))

(defun slime-sprof-browser-get-buffer ()
  (get-buffer-create "*slime-sprof-browser*"))

(defun slime-sprof-browser-insert-line (data name-length)
  (destructuring-bind (index name self cumul total)
      data
    (if index
        (insert (format "%-4d " index))
        (insert "     "))
    (slime-insert-propertized
     (slime-sprof-browser-name-properties)
     (format (format "%%-%ds " name-length)
             (abbreviate-name name name-length)))
    (insert (format "%6.2f " self))
    (when cumul
      (insert (format "%6.2f " cumul))
      (when total
        (insert (format "%6.2f" total))))
    (when index
      (slime-sprof-browser-add-line-text-properties
       `(profile-index ,index expanded nil)))
    (insert "\n")))

(defun abbreviate-name (name max-length)
  (lexical-let ((length (min (length name) max-length)))
    (subseq name 0 length)))

;; Expanding / collapsing

(defun slime-sprof-browser-toggle ()
  (interactive)
  (let ((index (get-text-property (point) 'profile-index)))
    (when index
      (save-excursion
        (if (slime-sprof-browser-line-expanded-p)
            (slime-sprof-browser-collapse)
            (slime-sprof-browser-expand))))))

(defun slime-sprof-browser-collapse ()
  (let ((inhibit-read-only t))
    (slime-sprof-browser-add-line-text-properties '(expanded nil))
    (forward-line)
    (loop until (or (eobp)
                    (get-text-property (point) 'profile-index))
          do
          (delete-region (point-at-bol) (point-at-eol))
          (unless (eobp)
            (delete-char 1)))))

(defun slime-sprof-browser-expand ()
  (lexical-let* ((buffer (current-buffer))
                 (point (point))
                 (index (get-text-property point 'profile-index)))
    (slime-eval-async `(swank:swank-sprof-expand-node ,index)
                      (lambda (data)
                        (with-current-buffer buffer
                          (save-excursion 
                            (destructuring-bind (&key callers calls)
                                data
                              (slime-sprof-browser-add-expansion callers
                                                                   "Callers"
                                                                   0)
                              (slime-sprof-browser-add-expansion calls
                                                                   "Calls"
                                                                   0))))))))

(defun slime-sprof-browser-add-expansion (data type nesting)
  (when data
    (let ((inhibit-read-only t))
      (slime-sprof-browser-add-line-text-properties '(expanded t))
      (end-of-line)
      (insert (format "\n     %s" type))
      (dolist (node data)
        (destructuring-bind (index name cumul) node
          (insert (format (format "\n%%%ds" (+ 7 (* 2 nesting))) ""))
          (slime-insert-propertized
           (slime-sprof-browser-name-properties)
           (let ((len (- 59 (* 2 nesting))))
             (format (format "%%-%ds " len)
                     (abbreviate-name name len))))
          (slime-sprof-browser-add-line-text-properties
           `(profile-sub-index ,index))
          (insert (format "%6.2f" cumul)))))))

(defun slime-sprof-browser-line-expanded-p ()
  (get-text-property (point) 'expanded))

(defun slime-sprof-browser-add-line-text-properties (properties)
  (add-text-properties (point-at-bol)
                       (point-at-eol)
                       properties))

(defun slime-sprof-browser-name-properties ()
  '(face sldb-restart-number-face))

;; "Go to function"

(defun slime-sprof-browser-go-to ()                                           
  (interactive)
  (let ((sub-index (get-text-property (point) 'profile-sub-index)))
    (when sub-index
      (let ((pos (text-property-any
                  (point-min) (point-max) 'profile-index sub-index)))
        (when pos (goto-char pos))))))

;; Disassembly

(defun slime-sprof-browser-disassemble-function ()
  (interactive)
  (let ((index (or (get-text-property (point) 'profile-index)
                   (get-text-property (point) 'profile-sub-index))))
    (when index
      (slime-eval-describe `(swank:swank-sprof-disassemble
                             ,index)))))

;; View source

(defun slime-sprof-browser-view-source ()
  (interactive)
  (let ((index (or (get-text-property (point) 'profile-index)
                   (get-text-property (point) 'profile-sub-index))))
    (when index
      (slime-eval-async
       `(swank:swank-sprof-source-location ,index)
       (lambda (source-location)
         (destructure-case source-location
           ((:error message)
            (message "%s" message)
            (ding))
           (t
            (slime-show-source-location source-location))))))))

(provide 'slime-sprof)
--- /project/slime/cvsroot/slime/contrib/swank-sprof.lisp	2009/09/21 19:08:29	NONE
+++ /project/slime/cvsroot/slime/contrib/swank-sprof.lisp	2009/09/21 19:08:29	1.1
;;; swank-sprof.lisp
;;
;; Authors: Juho Snellman
;;
;; License: MIT
;;

(in-package :swank)

#+sbcl(progn

#.(prog1 nil (require :sb-sprof))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :sb-sprof))

(defvar *call-graph* nil)
(defvar *node-numbers* nil)
(defvar *number-nodes* nil)

(defun pretty-name (name)
  (let ((*package* (find-package :common-lisp-user))
        (*print-right-margin* most-positive-fixnum))
    (format nil "~S" (if (consp name)
                         (let ((head (car name)))
                           (if (or (eq head 'sb-c::tl-xep)
                                   (eq head 'sb-c::hairy-arg-processor)
                                   (eq head 'sb-c::top-level-form)
                                   (eq head 'sb-c::xep))
                               (cadr name)
                               name))
                         name))))

(defun samples-percent (count)
  (sb-sprof::samples-percent *call-graph* count))

(defun node-values (node)
  (values (pretty-name (sb-sprof::node-name node))
          (samples-percent (sb-sprof::node-count node))
          (samples-percent (sb-sprof::node-accrued-count node))))

(defun serialize-call-graph ()
  (let ((nodes (sort (copy-list
                      (sb-sprof::call-graph-flat-nodes *call-graph*))
                     #'>
;;                     :key #'sb-sprof::node-count)))
                     :key #'sb-sprof::node-accrued-count)))
    (setf *number-nodes* (make-hash-table))
    (setf *node-numbers* (make-hash-table))
    (loop for node in nodes
          for i from 1
          with total = 0
          collect (multiple-value-bind (name self cumulative)
                      (node-values node)
                    (setf (gethash node *node-numbers*) i
                          (gethash i *number-nodes*) node)
                    (incf total self)
                    (list i name self cumulative total)) into list
          finally (return
                    (let ((rest (- 100 total)))
                      (return (append list
                                      `((nil "Elsewhere" ,rest nil nil)))))))))

(defslimefun swank-sprof-get-call-graph ()
  (setf *call-graph* (sb-sprof:report :type nil))
  (serialize-call-graph))


(defslimefun swank-sprof-expand-node (index)
  (let* ((node (gethash index *number-nodes*)))
    (labels ((caller-count (v)
               (loop for e in (sb-sprof::vertex-edges v) do
                     (when (eq (sb-sprof::edge-vertex e) node)
                       (return-from caller-count (sb-sprof::call-count e))))
               0)
             (serialize-node (node count)
               (etypecase node
                 (sb-sprof::cycle
                  (list (sb-sprof::cycle-index node)
                        (sb-sprof::cycle-name node)
                        (samples-percent count)))
                 (sb-sprof::node
                  (let ((name (node-values node)))
                    (list (gethash node *node-numbers*)
                          name
                          (samples-percent count)))))))
      (list :callers (let ((edges (sort (copy-list (sb-sprof::node-callers node))
                                        #'>
                                        :key #'caller-count)))
                       (loop for node in edges
                             collect (serialize-node node
                                                     (caller-count node))))
            :calls (let ((edges (sort (copy-list (sb-sprof::vertex-edges node))
                                      #'>
                                      :key #'sb-sprof::call-count)))
                     (loop for edge in edges
                           collect
                           (serialize-node (sb-sprof::edge-vertex edge)
                                           (sb-sprof::call-count edge))))))))

(defslimefun swank-sprof-disassemble (index)
  (let* ((node (gethash index *number-nodes*))
         (debug-info (sb-sprof::node-debug-info node)))
    (with-output-to-string (s)
      (typecase debug-info
        (sb-impl::code-component
         (sb-disassem::disassemble-memory (sb-vm::code-instructions debug-info)
                                          (sb-vm::%code-code-size debug-info)
                                          :stream s))
        (sb-di::compiled-debug-fun
         (let ((component (sb-di::compiled-debug-fun-component debug-info)))
           (sb-disassem::disassemble-code-component component :stream s)))
        (t `(:error "No disassembly available"))))))

(defslimefun swank-sprof-source-location (index)
  (let* ((node (gethash index *number-nodes*))
         (debug-info (sb-sprof::node-debug-info node)))
    (or (when (typep debug-info 'sb-di::compiled-debug-fun)
          (let* ((component (sb-di::compiled-debug-fun-component debug-info))
                 (function (sb-kernel::%code-entry-points component)))
            (when function
              (find-source-location function))))
        `(:error "No source location available"))))

(defslimefun swank-sprof-start ()
  (sb-sprof:start-profiling))

(defslimefun swank-sprof-stop ()
  (sb-sprof:stop-profiling))

)

(provide :swank-sprof)



From sboukarev at common-lisp.net  Mon Sep 21 19:36:54 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 21 Sep 2009 15:36:54 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1Mpogw-0008WJ-3s@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
* doc/slime.texi (slime-sprof): document slime-sprof contrib.


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/20 10:51:50	1.1861
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/21 19:36:53	1.1862
@@ -1,3 +1,7 @@
+2009-09-21  Stas Boukarev  <stassats at gmail.com>
+
+	* doc/slime.texi (slime-sprof): document slime-sprof contrib.
+
 2009-09-20  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* swank-abcl.lisp (thread-description): Fix typo.




From sboukarev at common-lisp.net  Mon Sep 21 19:36:54 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 21 Sep 2009 15:36:54 -0400
Subject: [slime-cvs] CVS slime/doc
Message-ID: <E1Mpogw-0008WV-Dk@common-lisp.net>

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

Modified Files:
	slime.texi 
Log Message:
* doc/slime.texi (slime-sprof): document slime-sprof contrib.


--- /project/slime/cvsroot/slime/doc/slime.texi	2009/08/27 14:48:46	1.78
+++ /project/slime/cvsroot/slime/doc/slime.texi	2009/09/21 19:36:54	1.79
@@ -12,7 +12,7 @@
 @set EDITION 3.0-alpha
 @set SLIMEVER 3.0-alpha
 @c @set UPDATED @today{}
- at set UPDATED @code{$Date: 2009/08/27 14:48:46 $}
+ at set UPDATED @code{$Date: 2009/09/21 19:36:54 $}
 @set TITLE SLIME User Manual
 @settitle @value{TITLE}, version @value{EDITION}
 
@@ -233,7 +233,8 @@
 * Documentation Links::         
 * Xref and Class Browser::      
 * Highlight Edits::             
-* Scratch Buffer::              
+* Scratch Buffer::
+* slime-sprof::
 * slime-fancy::                 
 
 REPL: the ``top level''
@@ -2096,7 +2097,8 @@
 * Documentation Links::         
 * Xref and Class Browser::      
 * Highlight Edits::             
-* Scratch Buffer::              
+* Scratch Buffer::
+* slime-sprof::
 * slime-fancy::                 
 @end menu
 
@@ -2842,6 +2844,34 @@
 
 @end table
 
+ at node slime-sprof
+ at section @code{slime-sprof}
+
+ at code{slime-sprof} is a package for integrating SBCL's statistical profiler, sb-sprof.
+
+ at table @kbd
+
+ at cmditem{slime-sprof-start}
+Start profiling.
+
+ at cmditem{slime-sprof-stop}
+Stop profiling.
+ at cmditem{slime-sprof-browser}
+Report results of the profiling.
+ at end table
+
+The following keys are defined in slime-sprof-browser mode:
+ at table @kbd
+
+ at kbditem{RET, slime-sprof-browser-toggle}
+Expand / collapse function details (callers, calls to)
+ at kbditem{v, slime-sprof-browser-view-source}
+View function sources. 
+ at kbditem{d, slime-sprof-browser-disassemble-function}
+Disassabmle function.
+
+ at end table
+
 @node slime-fancy
 @section Meta package: @code{slime-fancy}
 




From heller at common-lisp.net  Wed Sep 23 11:19:56 2009
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 23 Sep 2009 07:19:56 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MqPt6-0004Rd-0Z@common-lisp.net>

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

Modified Files:
	ChangeLog swank-ccl.lisp 
Log Message:
* swank-ccl.lisp (find-definitions): For fbound symbols also
consider source-notes in the function object.  Useful if
the function slot was set with (setf (symbol-function ..))
and not by defun.

--- /project/slime/cvsroot/slime/ChangeLog	2009/09/21 19:36:53	1.1862
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/23 11:19:55	1.1863
@@ -1,3 +1,10 @@
+2009-09-22  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-ccl.lisp (find-definitions): For fbound symbols also
+	consider source-notes in the function object.  Useful if
+	the function slot was set with (setf (symbol-function ..))
+	and not by defun.
+
 2009-09-21  Stas Boukarev  <stassats at gmail.com>
 
 	* doc/slime.texi (slime-sprof): document slime-sprof contrib.
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2009/08/31 17:08:17	1.5
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2009/09/23 11:19:55	1.6
@@ -581,13 +581,17 @@
               (t `(:error ,(funcall if-nil-thunk))))
       (error (c) `(:error ,(princ-to-string c))))))
 
-(defimplementation find-definitions (obj)
-  (loop for ((type . name) . sources) in (ccl:find-definition-sources obj)
-        collect (list (definition-name type name)
-                      (source-note-to-source-location
-                       (find-if-not #'null sources)
-                       (lambda () "No source-note available")
-                       name))))
+(defimplementation find-definitions (name)
+  (let ((defs (or (ccl:find-definition-sources name)
+                  (and (symbolp name)
+                       (fboundp name)
+                       (ccl:find-definition-sources (symbol-function name))))))
+    (loop for ((type . name) . sources) in defs
+          collect (list (definition-name type name)
+                        (source-note-to-source-location
+                         (find-if-not #'null sources)
+                         (lambda () "No source-note available")
+                         name)))))
 
 (defimplementation find-source-location (obj)
   (let* ((defs (ccl:find-definition-sources obj))




From heller at common-lisp.net  Wed Sep 23 11:20:02 2009
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 23 Sep 2009 07:20:02 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MqPtC-0004TS-Uj@common-lisp.net>

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
* swank-sbcl.lisp (receive-if): Bind *break-on-signals* to
nil before using with-timeout.

--- /project/slime/cvsroot/slime/ChangeLog	2009/09/23 11:19:55	1.1863
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/23 11:20:02	1.1864
@@ -1,3 +1,8 @@
+2009-09-23  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-sbcl.lisp (receive-if): Bind *break-on-signals* to
+	nil before using with-timeout.
+
 2009-09-22  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-ccl.lisp (find-definitions): For fbound symbols also
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/08/11 09:15:03	1.249
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/09/23 11:20:02	1.250
@@ -1488,9 +1488,11 @@
          (when (eq timeout t) (return (values nil t)))
          ;; FIXME: with-timeout doesn't work properly on Darwin
          #+linux
-         (handler-case (sb-ext:with-timeout 0.2
-                         (sb-thread:condition-wait (mailbox.waitqueue mbox)
-                                                   mutex))
+         (handler-case 
+             (let ((*break-on-signals* nil))
+               (sb-ext:with-timeout 0.2
+                 (sb-thread:condition-wait (mailbox.waitqueue mbox)
+                                           mutex)))
            (sb-ext:timeout ()))
          #-linux  
          (sb-thread:condition-wait (mailbox.waitqueue mbox)




From sboukarev at common-lisp.net  Thu Sep 24 11:30:46 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Thu, 24 Sep 2009 07:30:46 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MqmX8-00043Z-Vf@common-lisp.net>

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
* doc/slime.texi: Fix a typo.
* swank-sbcl.lisp (swank-compile-string): Ignore unused variable
warningsp.


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/23 11:20:02	1.1864
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/24 11:30:46	1.1865
@@ -1,3 +1,8 @@
+2009-09-24  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-sbcl.lisp (swank-compile-string): Ignore unused variable
+	warningsp.
+
 2009-09-23  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-sbcl.lisp (receive-if): Bind *break-on-signals* to
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/09/23 11:20:02	1.250
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/09/24 11:30:46	1.251
@@ -631,6 +631,7 @@
                                         :emacs-position position))
                  (multiple-value-bind (output-file warningsp failurep)
                      (compile-file temp-file-name)
+                   (declare (ignore warningsp))
                    (unless failurep
                      (funcall cont output-file)))))))
       (with-open-file (s temp-file-name :direction :output :if-exists :error)




From sboukarev at common-lisp.net  Thu Sep 24 11:30:47 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Thu, 24 Sep 2009 07:30:47 -0400
Subject: [slime-cvs] CVS slime/doc
Message-ID: <E1MqmX9-00043o-9F@common-lisp.net>

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

Modified Files:
	slime.texi 
Log Message:
* doc/slime.texi: Fix a typo.
* swank-sbcl.lisp (swank-compile-string): Ignore unused variable
warningsp.


--- /project/slime/cvsroot/slime/doc/slime.texi	2009/09/21 19:36:54	1.79
+++ /project/slime/cvsroot/slime/doc/slime.texi	2009/09/24 11:30:47	1.80
@@ -12,7 +12,7 @@
 @set EDITION 3.0-alpha
 @set SLIMEVER 3.0-alpha
 @c @set UPDATED @today{}
- at set UPDATED @code{$Date: 2009/09/21 19:36:54 $}
+ at set UPDATED @code{$Date: 2009/09/24 11:30:47 $}
 @set TITLE SLIME User Manual
 @settitle @value{TITLE}, version @value{EDITION}
 
@@ -2868,7 +2868,7 @@
 @kbditem{v, slime-sprof-browser-view-source}
 View function sources. 
 @kbditem{d, slime-sprof-browser-disassemble-function}
-Disassabmle function.
+Disassemble function.
 
 @end table
 




From trittweiler at common-lisp.net  Fri Sep 25 06:43:33 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 25 Sep 2009 02:43:33 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1Mr4Wj-00015V-DK@common-lisp.net>

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

Modified Files:
	swank-sbcl-exts.lisp ChangeLog 
Log Message:
	* swank-sbcl-exts.lisp: Add EVAL-WHEN to prevent subtle dependency
	problem.


--- /project/slime/cvsroot/slime/contrib/swank-sbcl-exts.lisp	2009/07/15 19:37:25	1.3
+++ /project/slime/cvsroot/slime/contrib/swank-sbcl-exts.lisp	2009/09/25 06:43:33	1.4
@@ -7,7 +7,8 @@
 
 (in-package :swank)
 
-(swank-require :swank-arglists)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (swank-require :swank-arglists))
 
 ;; We need to do this so users can place `slime-sbcl-exts' into their
 ;; ~/.emacs, and still use any implementation they want.
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/21 19:08:28	1.247
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/25 06:43:33	1.248
@@ -1,3 +1,8 @@
+2009-09-25  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank-sbcl-exts.lisp: Add EVAL-WHEN to prevent subtle dependency
+	problem.
+
 2009-09-21  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-sprof.el, swank-sprof.lisp: New contrib for




From trittweiler at common-lisp.net  Sat Sep 26 23:24:51 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 26 Sep 2009 19:24:51 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MrgdH-0006OI-1R@common-lisp.net>

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
	* swank-sbcl.lisp (call-with-debugger-hook): Correctly deal with
	case of HOOK being NIL.
	(make-definition-source-location): Somewhat simplified.
	(string-path-snippet): Removed, not needed anymore.


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/24 11:30:46	1.1865
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/26 23:24:50	1.1866
@@ -1,3 +1,10 @@
+2009-09-27  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank-sbcl.lisp (call-with-debugger-hook): Correctly deal with
+	case of HOOK being NIL.
+	(make-definition-source-location): Somewhat simplified.
+	(string-path-snippet): Removed, not needed anymore.
+
 2009-09-24  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-sbcl.lisp (swank-compile-string): Ignore unused variable
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/09/24 11:30:46	1.251
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/09/26 23:24:50	1.252
@@ -742,15 +742,18 @@
         plist
       (cond
         (emacs-buffer
-         (let* ((*readtable* (guess-readtable-for-filename emacs-directory))
-                (pos (if form-path
-                         (with-debootstrapping
-                           (source-path-string-position form-path emacs-string))
-                         character-offset))
-                (snippet (string-path-snippet emacs-string form-path pos)))
-           (make-location `(:buffer ,emacs-buffer)
-                          `(:offset ,emacs-position ,pos)
-                          `(:snippet ,snippet))))
+         (let ((*readtable* (guess-readtable-for-filename emacs-directory)))
+           (multiple-value-bind (start end)
+               (if form-path
+                   (with-debootstrapping
+                     (source-path-string-position form-path emacs-string))
+                   (values character-offset most-positive-fixnum))
+             (make-location `(:buffer ,emacs-buffer)
+                            `(:offset ,emacs-position ,start)
+                            `(:snippet
+                              ,(subseq emacs-string
+                                       start
+                                       (min end (+ start *source-snippet-size*))))))))
         ((not pathname)
          `(:error ,(format nil "Source definition of ~A ~A not found"
                            (string-downcase type) name)))
@@ -765,18 +768,6 @@
                           `(:position ,(1+ pos))
                           `(:snippet ,snippet))))))))
 
-(defun string-path-snippet (string form-path position)
-  (if (null form-path)
-      (read-snippet-from-string string)
-      ;; If we have a form-path, use it to derive a more accurate
-      ;; snippet, so that we can point to the individual form rather
-      ;; than just the toplevel form.
-      (multiple-value-bind (data end)
-          (let ((*read-suppress* t))
-            (read-from-string string nil nil :start position))
-        (declare (ignore data))
-        (subseq string position (min end *source-snippet-size*)))))    
-    
 (defun source-file-position (filename write-date form-path character-offset)
   (let ((source (get-source-code filename write-date))
         (*readtable* (guess-readtable-for-filename filename)))
@@ -984,7 +975,7 @@
 
 (defimplementation call-with-debugger-hook (hook fun)
   (let ((*debugger-hook* hook)
-        (sb-ext:*invoke-debugger-hook* (make-invoke-debugger-hook hook))
+        (sb-ext:*invoke-debugger-hook* (and hook (make-invoke-debugger-hook hook)))
         #+#.(swank-backend::sbcl-with-new-stepper-p)
         (sb-ext:*stepper-hook*
          (lambda (condition)




From sboukarev at common-lisp.net  Mon Sep 28 11:33:43 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 28 Sep 2009 07:33:43 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MsEUB-0005Ok-Ew@common-lisp.net>

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

Modified Files:
	ChangeLog swank-lispworks.lisp 
Log Message:
swank-lispworks.lisp (replace-strings-with-symbols): Didn't work on
non-proper lists. Reported by Madhu.


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/26 23:24:50	1.1866
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/28 11:33:43	1.1867
@@ -1,3 +1,8 @@
+2009-09-28  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-lispworks.lisp (replace-strings-with-symbols): Didn't work on
+	non-proper lists. Reported by Madhu.
+
 2009-09-27  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* swank-sbcl.lisp (call-with-debugger-hook): Correctly deal with
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/09/02 17:21:15	1.132
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/09/28 11:33:43	1.133
@@ -184,18 +184,26 @@
 
 ;;;; Documentation
 
+(defun map-list (function list)
+  "Map over proper and not proper lists."
+  (loop for (car . cdr) on list
+        collect (funcall function car) into result
+        when (null cdr) return result
+        when (atom cdr) return (nconc result (funcall function cdr))))
+
 (defun replace-strings-with-symbols (tree)
-  (mapcar (lambda (x)
-            (typecase x
-              (list
-               (replace-strings-with-symbols x))
-              (symbol
-               x)
-              (string
-               (intern x))
-              (t
-               (intern (write-to-string x)))))
-          tree))
+  (map-list
+   (lambda (x)
+     (typecase x
+       (list
+        (replace-strings-with-symbols x))
+       (symbol
+        x)
+       (string
+        (intern x))
+       (t
+        (intern (write-to-string x)))))
+   tree))
                
 (defimplementation arglist (symbol-or-function)
   (let ((arglist (lw:function-lambda-list symbol-or-function)))




From sboukarev at common-lisp.net  Mon Sep 28 14:56:20 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 28 Sep 2009 10:56:20 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MsHeG-0003gE-2U@common-lisp.net>

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
swank.lisp (set-package): Provide a more meaningful error
message when package doesn't exist.


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/28 11:33:43	1.1867
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/28 14:56:19	1.1868
@@ -1,5 +1,8 @@
 2009-09-28  Stas Boukarev  <stassats at gmail.com>
 
+	* swank.lisp (set-package): Provide a more meaningful error
+	message when package doesn't exist.
+
 	* swank-lispworks.lisp (replace-strings-with-symbols): Didn't work on
 	non-proper lists. Reported by Madhu.
 
--- /project/slime/cvsroot/slime/swank.lisp	2009/09/20 09:39:16	1.661
+++ /project/slime/cvsroot/slime/swank.lisp	2009/09/28 14:56:19	1.662
@@ -2228,7 +2228,7 @@
   "Set *package* to the package named NAME.
 Return the full package-name and the string to use in the prompt."
   (let ((p (guess-package name)))
-    (assert (packagep p))
+    (assert (packagep p) nil "Package ~a doesn't exist." name)
     (setq *package* p)
     (list (package-name p) (package-string-for-prompt p))))
 




From sboukarev at common-lisp.net  Mon Sep 28 21:28:29 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 28 Sep 2009 17:28:29 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MsNll-0008HH-95@common-lisp.net>

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

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
* slime-repl.el (slime-sync-package-and-default-directory):
Do not try to set package if it doesn't exists.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/25 06:43:33	1.248
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/28 21:28:29	1.249
@@ -1,3 +1,8 @@
+2009-09-28  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-repl.el (slime-sync-package-and-default-directory):
+	Do not try to set package if it doesn't exists.
+
 2009-09-25  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* swank-sbcl-exts.lisp: Add EVAL-WHEN to prevent subtle dependency
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/09/17 14:56:22	1.25
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/09/28 21:28:29	1.26
@@ -1449,9 +1449,11 @@
 (defun slime-sync-package-and-default-directory ()
   "Set Lisp's package and directory to the values in current buffer."
   (interactive)
-  (let ((package (slime-current-package))
-        (directory default-directory))
-    (when package
+  (let* ((package (slime-current-package))
+         (exists-p (or (null package)
+                       (slime-eval `(swank::guess-package ,package))))
+         (directory default-directory))
+    (when (and package exists-p)
       (slime-repl-set-package package))
     (slime-set-default-directory directory)
     ;; Sync *inferior-lisp* dir
@@ -1460,9 +1462,10 @@
       (when buffer
         (with-current-buffer buffer
           (setq default-directory directory))))
-    (message "package: %s  default-directory: %s"
+    (message "package: %s%s  directory: %s"
              (with-current-buffer (slime-output-buffer)
                (slime-lisp-package))
+             (if exists-p "" (format " (package %s doesn't exist)" package))
              directory)))
 
 (defun slime-goto-connection ()




From sboukarev at common-lisp.net  Tue Sep 29 03:21:31 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 28 Sep 2009 23:21:31 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MsTHP-0006dH-54@common-lisp.net>

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

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
contrib/slime-repl.el (slime-sync-package-and-default-directory): Better checking for packages.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/28 21:28:29	1.249
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/29 03:21:30	1.250
@@ -1,3 +1,8 @@
+2009-09-29  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-repl.el (slime-sync-package-and-default-directory):
+	Better checking for packages.
+
 2009-09-28  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-repl.el (slime-sync-package-and-default-directory):
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/09/28 21:28:29	1.26
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/09/29 03:21:31	1.27
@@ -1451,7 +1451,7 @@
   (interactive)
   (let* ((package (slime-current-package))
          (exists-p (or (null package)
-                       (slime-eval `(swank::guess-package ,package))))
+                       (slime-eval `(cl:packagep (swank::guess-package ,package)))))
          (directory default-directory))
     (when (and package exists-p)
       (slime-repl-set-package package))