From sboukarev at common-lisp.net  Tue Oct  6 20:12:03 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Tue, 06 Oct 2009 16:12:03 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MvGOB-0004sP-Sy@common-lisp.net>

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

Modified Files:
	ChangeLog swank-ccl.lisp 
Log Message:
swank-ccl.lisp (map-backtrace): Handle null end-frame-number argument.


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/28 14:56:19	1.1868
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/06 20:12:03	1.1869
@@ -1,3 +1,7 @@
+2009-10-06  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-ccl.lisp (map-backtrace): Handle null end-frame-number argument.
+
 2009-09-28  Stas Boukarev  <stassats at gmail.com>
 
 	* swank.lisp (set-package): Provide a more meaningful error
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2009/09/23 11:19:55	1.6
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2009/10/06 20:12:03	1.7
@@ -385,16 +385,17 @@
   )
 
 (defun map-backtrace (function &optional
-                               (start-frame-number 0)
-                               (end-frame-number most-positive-fixnum))
+                      (start-frame-number 0)
+                      end-frame-number)
   "Call FUNCTION passing information about each stack frame
  from frames START-FRAME-NUMBER to END-FRAME-NUMBER."
-  (ccl:map-call-frames function
-                       :origin ccl:*top-error-frame*
-                       :start-frame-number start-frame-number
-                       :count (- end-frame-number start-frame-number)
-                       :test (and (not t) ;(not (symbol-value (swank-sym *sldb-show-internal-frames*)))
-                                  'interesting-frame-p)))
+  (let ((end-frame-number (or end-frame-number most-positive-fixnum)))
+    (ccl:map-call-frames function
+                         :origin ccl:*top-error-frame*
+                         :start-frame-number start-frame-number
+                         :count (- end-frame-number start-frame-number)
+                         :test (and (not t) ;(not (symbol-value (swank-sym *sldb-show-internal-frames*)))
+                                    'interesting-frame-p))))
 
 ;; Exceptions
 (defvar *interesting-internal-frames* ())




From sboukarev at common-lisp.net  Fri Oct  9 13:36:39 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 09 Oct 2009 09:36:39 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MwFeB-0007fH-BZ@common-lisp.net>

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

Modified Files:
	ChangeLog slime-sprof.el swank-sprof.lisp 
Log Message:
* contrib/slime-sprof.el: Slightly factor code, add menu entries.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/09/29 03:21:30	1.250
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/09 13:36:38	1.251
@@ -1,3 +1,7 @@
+2009-10-09  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-sprof.el: Slightly factor code, add menu entries.
+
 2009-09-29  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-repl.el (slime-sync-package-and-default-directory):
--- /project/slime/cvsroot/slime/contrib/slime-sprof.el	2009/09/21 19:08:29	1.1
+++ /project/slime/cvsroot/slime/contrib/slime-sprof.el	2009/10/09 13:36:39	1.2
@@ -17,18 +17,7 @@
   "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))
+  (setq buffer-read-only t))
 
 (slime-define-keys slime-sprof-browser-mode-map
   ("h" 'describe-mode)
@@ -50,17 +39,38 @@
 
 ;; Reporting
 
+(defun slime-sprof-format (graph)
+  (with-current-buffer (slime-sprof-browser-buffer)
+    (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))
+
+(defun slime-sprof-update ()
+  (interactive)
+  (slime-eval-async `(swank:swank-sprof-get-call-graph)
+                    'slime-sprof-format))
+
 (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))))))
+  (switch-to-buffer (slime-sprof-browser-buffer))
+  (slime-sprof-update))
 
-(defun slime-sprof-browser-get-buffer ()
-  (get-buffer-create "*slime-sprof-browser*"))
+(defun slime-sprof-browser-buffer ()
+  (if (get-buffer "*slime-sprof-browser*")
+      (get-buffer "*slime-sprof-browser*")
+      (let ((connection (slime-connection)))
+        (with-current-buffer (get-buffer-create "*slime-sprof-browser*")
+          (slime-sprof-browser-mode)
+          (setq slime-buffer-connection connection)
+          (current-buffer)))))
 
 (defun slime-sprof-browser-insert-line (data name-length)
   (destructuring-bind (index name self cumul total)
@@ -191,4 +201,15 @@
            (t
             (slime-show-source-location source-location))))))))
 
+;;; Menu
+
+(defun slime-sprof-init ()
+  (let ((C '(and (slime-connected-p)
+             (equal (slime-lisp-implementation-type) "SBCL"))))
+    (setf (cdr (last (assoc "Profiling" slime-easy-menu)))
+          `("--"
+            [ "Start sb-sprof"  slime-sprof-start ,C ]
+            [ "Stop sb-sprof"   slime-sprof-stop ,C ]
+            [ "Report sb-sprof" slime-sprof-browser ,C ]))))
+
 (provide 'slime-sprof)
--- /project/slime/cvsroot/slime/contrib/swank-sprof.lisp	2009/09/21 19:08:29	1.1
+++ /project/slime/cvsroot/slime/contrib/swank-sprof.lisp	2009/10/09 13:36:39	1.2
@@ -7,13 +7,12 @@
 
 (in-package :swank)
 
-#+sbcl(progn
-
-#.(prog1 nil (require :sb-sprof))
-
+#-sbcl
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (require :sb-sprof))
 
+#+sbcl(progn
+
 (defvar *call-graph* nil)
 (defvar *node-numbers* nil)
 (defvar *number-nodes* nil)




From sboukarev at common-lisp.net  Fri Oct  9 14:57:45 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 09 Oct 2009 10:57:45 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MwGuf-0006JH-Ko@common-lisp.net>

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

Modified Files:
	ChangeLog slime-sprof.el swank-sprof.lisp 
Log Message:
* contrib{slime-sprof.el,swank-sprof.lisp}: Add ability to exclude functions which symbols
are from swank package.
* doc/slime.texi: document it.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/09 13:36:38	1.251
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/09 14:57:45	1.252
@@ -1,5 +1,12 @@
 2009-10-09  Stas Boukarev  <stassats at gmail.com>
 
+	* swank-sprof.lisp: Add ability to exclude functions which symbols
+	are from swank package.
+	* slime-sprof.el (slime-sprof-toggle-swank-exclusion): New function.
+	Bound to s in the slime-sprof buffer.
+	* slime-sprof.el (slime-sprof-exclude-swank): New variable for
+	controlling exclusion of swank functions.
+
 	* slime-sprof.el: Slightly factor code, add menu entries.
 
 2009-09-29  Stas Boukarev  <stassats at gmail.com>
--- /project/slime/cvsroot/slime/contrib/slime-sprof.el	2009/10/09 13:36:39	1.2
+++ /project/slime/cvsroot/slime/contrib/slime-sprof.el	2009/10/09 14:57:45	1.3
@@ -12,6 +12,9 @@
 
 (slime-require :swank-sprof)
 
+(defvar slime-sprof-exclude-swank nil
+  "*Display swank functions in the report.")
+
 (define-derived-mode slime-sprof-browser-mode fundamental-mode
   "slprof"
   "Mode for browsing profiler data\
@@ -25,6 +28,7 @@
   ("d" 'slime-sprof-browser-disassemble-function)
   ("g" 'slime-sprof-browser-go-to)
   ("v" 'slime-sprof-browser-view-source)
+  ("s" 'slime-sprof-toggle-swank-exclusion)
   ((kbd "RET") 'slime-sprof-browser-toggle))
 
 ;; Start / stop profiling
@@ -53,9 +57,9 @@
         (slime-sprof-browser-insert-line data 54))))
   (goto-line 2))
 
-(defun slime-sprof-update ()
-  (interactive)
-  (slime-eval-async `(swank:swank-sprof-get-call-graph)
+(defun* slime-sprof-update (&optional (exclude-swank slime-sprof-exclude-swank))
+  (slime-eval-async `(swank:swank-sprof-get-call-graph
+                      :exclude-swank ,exclude-swank)
                     'slime-sprof-format))
 
 (defun slime-sprof-browser ()
@@ -72,6 +76,12 @@
           (setq slime-buffer-connection connection)
           (current-buffer)))))
 
+(defun slime-sprof-toggle-swank-exclusion ()
+  (interactive)
+  (setq slime-sprof-exclude-swank
+        (not slime-sprof-exclude-swank))
+  (slime-sprof-update))
+
 (defun slime-sprof-browser-insert-line (data name-length)
   (destructuring-bind (index name self cumul total)
       data
--- /project/slime/cvsroot/slime/contrib/swank-sprof.lisp	2009/10/09 13:36:39	1.2
+++ /project/slime/cvsroot/slime/contrib/swank-sprof.lisp	2009/10/09 14:57:45	1.3
@@ -7,7 +7,7 @@
 
 (in-package :swank)
 
-#-sbcl
+#+sbcl
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (require :sb-sprof))
 
@@ -38,12 +38,22 @@
           (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)))
+(defun filter-swank-nodes (nodes)
+  (let ((swank-package (find-package :swank)))
+    (remove-if (lambda (node)
+                 (let ((name (sb-sprof::node-name node)))
+                   (and (symbolp name)
+                        (eql (symbol-package name)
+                             swank-package))))
+               nodes)))
+
+(defun serialize-call-graph (&key exclude-swank)
+  (let ((nodes (sb-sprof::call-graph-flat-nodes *call-graph*)))
+    (when exclude-swank
+      (setf nodes (filter-swank-nodes nodes)))
+    (setf nodes (sort (copy-list nodes) #'>
+                      ;; :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
@@ -60,10 +70,9 @@
                       (return (append list
                                       `((nil "Elsewhere" ,rest nil nil)))))))))
 
-(defslimefun swank-sprof-get-call-graph ()
+(defslimefun swank-sprof-get-call-graph (&key exclude-swank)
   (setf *call-graph* (sb-sprof:report :type nil))
-  (serialize-call-graph))
-
+  (serialize-call-graph :exclude-swank exclude-swank))
 
 (defslimefun swank-sprof-expand-node (index)
   (let* ((node (gethash index *number-nodes*)))




From sboukarev at common-lisp.net  Fri Oct  9 14:57:45 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 09 Oct 2009 10:57:45 -0400
Subject: [slime-cvs] CVS slime/doc
Message-ID: <E1MwGuf-0006JZ-Sq@common-lisp.net>

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

Modified Files:
	slime.texi 
Log Message:
* contrib{slime-sprof.el,swank-sprof.lisp}: Add ability to exclude functions which symbols
are from swank package.
* doc/slime.texi: document it.


--- /project/slime/cvsroot/slime/doc/slime.texi	2009/09/24 11:30:47	1.80
+++ /project/slime/cvsroot/slime/doc/slime.texi	2009/10/09 14:57:45	1.81
@@ -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/24 11:30:47 $}
+ at set UPDATED @code{$Date: 2009/10/09 14:57:45 $}
 @set TITLE SLIME User Manual
 @settitle @value{TITLE}, version @value{EDITION}
 
@@ -2849,6 +2849,9 @@
 
 @code{slime-sprof} is a package for integrating SBCL's statistical profiler, sb-sprof.
 
+The variable @code{slime-sprof-exclude-swank} controls whether to
+display swank functions. The default value is NIL.
+
 @table @kbd
 
 @cmditem{slime-sprof-start}
@@ -2869,6 +2872,8 @@
 View function sources. 
 @kbditem{d, slime-sprof-browser-disassemble-function}
 Disassemble function.
+ at kbditem{s, slime-sprof-toggle-swank-exclusion}
+Toggle exclusion of swank functions from the report.
 
 @end table
 




From sboukarev at common-lisp.net  Fri Oct  9 23:05:12 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 09 Oct 2009 19:05:12 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MwOWO-0005oO-TR@common-lisp.net>

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (stop-server): (list-threads) returns threads offset by 1,
don't kill the wrong thread.
Reported by Sebastian Tennant.


--- /project/slime/cvsroot/slime/ChangeLog	2009/10/06 20:12:03	1.1869
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/09 23:05:12	1.1870
@@ -1,3 +1,8 @@
+2009-10-09  Stas Boukarev  <stassats at gmail.com>
+
+	* swank.lisp (stop-server): (list-threads) returns threads offset by 1,
+	don't kill the wrong thread.
+
 2009-10-06  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-ccl.lisp (map-backtrace): Handle null end-frame-number argument.
--- /project/slime/cvsroot/slime/swank.lisp	2009/09/28 14:56:19	1.662
+++ /project/slime/cvsroot/slime/swank.lisp	2009/10/09 23:05:12	1.663
@@ -814,7 +814,7 @@
                                (cat "Swank " (princ-to-string port))))
                (list-threads))))
          (when thread-position
-           (kill-nth-thread thread-position)
+           (kill-nth-thread (1- thread-position))
            (close-socket socket)
            (remf *listener-sockets* port))))
       ((:fd-handler :sigio)




From trittweiler at common-lisp.net  Sat Oct 10 07:56:37 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 10 Oct 2009 03:56:37 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MwWof-0006AW-QS@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
	* slime.el (slime-length=): Fix (slime-length= '() 0).
	(slime-eval-feature-expression): Fix. Couldn't handle (NOT)
	and (NOT FOO BAR).


--- /project/slime/cvsroot/slime/slime.el	2009/09/20 09:39:16	1.1224
+++ /project/slime/cvsroot/slime/slime.el	2009/10/10 07:56:37	1.1225
@@ -8321,8 +8321,10 @@
   (etypecase seq
     (list
      (let ((list seq))
-       (setq list (nthcdr (1- n) list))
-       (and list (null (cdr list)))))
+       (if (and (null list) (zerop n))
+           t
+           (let ((tail (nthcdr (1- n) list)))
+             (and tail (null (cdr tail)))))))
     (sequence
      (= (length seq) n))))
 
@@ -8450,8 +8452,12 @@
                 name 
               (concat ":" name)))))
 
+(put 'slime-incorrect-feature-expression
+     'error-conditions '(slime-incorrect-feature-expression error))
+
 (put 'slime-unknown-feature-expression
-     'error-conditions '(slime-unknown-feature-expression error))
+     'error-conditions '(slime-unknown-feature-expression 
+                         slime-incorrect-feature-expression))
 
 (defun slime-eval-feature-expression (e)
   "Interpret a reader conditional expression."
@@ -8462,11 +8468,18 @@
                     (case head
                       (:and #'every)
                       (:or #'some)
-                      (:not (lambda (f l) (not (apply f l))))
+                      (:not 
+                         (lexical-let ((feature-expression e))
+                           (lambda (f l) 
+                             (cond 
+                               ((slime-length= l 0) t)
+                               ((slime-length= l 1) (not (apply f l)))
+                               (t (signal 'slime-incorrect-feature-expression 
+                                          feature-expression))))))
                       (t (signal 'slime-unknown-feature-expression head))))
                   #'slime-eval-feature-expression
                   (cdr e)))
-        (t (signal 'slime-unknown-feature-expression e))))
+        (t (signal 'slime-incorrect-feature-expression e))))
 
 ;;;;; Extracting Lisp forms from the buffer or user
 
--- /project/slime/cvsroot/slime/ChangeLog	2009/10/09 23:05:12	1.1870
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/10 07:56:37	1.1871
@@ -1,3 +1,9 @@
+2009-10-10  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-length=): Fix (slime-length= '() 0).
+	(slime-eval-feature-expression): Fix. Couldn't handle (NOT)
+	and (NOT FOO BAR).
+
 2009-10-09  Stas Boukarev  <stassats at gmail.com>
 
 	* swank.lisp (stop-server): (list-threads) returns threads offset by 1,




From trittweiler at common-lisp.net  Sat Oct 10 07:58:21 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 10 Oct 2009 03:58:21 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MwWqK-0006GM-RV@common-lisp.net>

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

Modified Files:
	slime-fontifying-fu.el ChangeLog 
Log Message:
	* slime-fontifying-fu.el (slime-search-suppressed-forms): Add
	clause for new condition `slime-incorrect-feature-expression'.
	([test] font-lock-magic): Add new test case.


--- /project/slime/cvsroot/slime/contrib/slime-fontifying-fu.el	2009/07/04 09:54:16	1.14
+++ /project/slime/cvsroot/slime/contrib/slime-fontifying-fu.el	2009/10/10 07:58:20	1.15
@@ -69,16 +69,18 @@
       (while (and (eq result 'retry) (<= (point) limit))
         (condition-case condition
             (setq result (slime-search-suppressed-forms-internal limit))
-          (end-of-file                      ; e.g. #+(
+          (end-of-file                        ; e.g. #+(
            (setq result nil)) 
           ;; We found a reader conditional we couldn't process for
           ;; some reason; however, there may still be other reader
           ;; conditionals before `limit'.
-          (invalid-read-syntax              ; e.g. #+#.foo
+          (invalid-read-syntax                ; e.g. #+#.foo
            (setq result 'retry))
-          (scan-error                       ; e.g. #+nil (foo ...
+          (scan-error                         ; e.g. #+nil (foo ...
            (setq result 'retry)) 
-          (slime-unknown-feature-expression ; e.g. #+(foo)
+          (slime-incorrect-feature-expression ; e.g. #+(not foo bar)
+           (setq result 'retry))
+          (slime-unknown-feature-expression   ; e.g. #+(foo)
            (setq result 'retry)) 
           (error
            (setq result nil)
@@ -300,6 +302,17 @@
    *YES*
 \)
 
+*NO*")
+      ("#-(not) *YES* *NO*
+
+*NO*
+
+#+(not) *NO* *NO*
+
+*NO*
+
+#+(not a b c) *NO* *NO*
+
 *NO*"))
   (slime-check-top-level)
   (with-temp-buffer
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/09 14:57:45	1.252
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/10 07:58:20	1.253
@@ -1,3 +1,9 @@
+2009-10-10  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-fontifying-fu.el (slime-search-suppressed-forms): Add
+	clause for new condition `slime-incorrect-feature-expression'.
+	([test] font-lock-magic): Add new test case.
+
 2009-10-09  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-sprof.lisp: Add ability to exclude functions which symbols




From sboukarev at common-lisp.net  Sat Oct 10 13:44:34 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sat, 10 Oct 2009 09:44:34 -0400
Subject: [slime-cvs] CVS slime/doc
Message-ID: <E1MwcFO-0006bG-TS@common-lisp.net>

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

Modified Files:
	slime.texi 
Log Message:
Fix typo: swank-backend::preferred-communication-style isn't exported.


--- /project/slime/cvsroot/slime/doc/slime.texi	2009/10/09 14:57:45	1.81
+++ /project/slime/cvsroot/slime/doc/slime.texi	2009/10/10 13:44:34	1.82
@@ -12,7 +12,7 @@
 @set EDITION 3.0-alpha
 @set SLIMEVER 3.0-alpha
 @c @set UPDATED @today{}
- at set UPDATED @code{$Date: 2009/10/09 14:57:45 $}
+ at set UPDATED @code{$Date: 2009/10/10 13:44:34 $}
 @set TITLE SLIME User Manual
 @settitle @value{TITLE}, version @value{EDITION}
 
@@ -1795,7 +1795,7 @@
 capabilities of your Lisp system. The general order of preference is
 @code{:SPAWN}, then @code{:SIGIO}, then @code{:FD-HANDLER}, with
 @code{NIL} as a last resort. You can check the default style by
-calling @code{SWANK-BACKEND:PREFERRED-COMMUNICATION-STYLE}. You can
+calling @code{SWANK-BACKEND::PREFERRED-COMMUNICATION-STYLE}. You can
 also override the default by setting
 @code{SWANK:*COMMUNICATION-STYLE*} in your Swank init file.
 




From sboukarev at common-lisp.net  Sun Oct 11 22:16:19 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sun, 11 Oct 2009 18:16:19 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1Mx6iB-0007pu-MF@common-lisp.net>

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

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
* contrib/slime-repl.el (slime-repl-set-package): Don't double unfinished input
and don't move point if it's inside the input area.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/10 07:58:20	1.253
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/11 22:16:19	1.254
@@ -1,3 +1,8 @@
+2009-10-12  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-repl.el (slime-repl-set-package): Don't double unfinished input
+	and don't move point if it's inside the input area.
+
 2009-10-10  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-fontifying-fu.el (slime-search-suppressed-forms): Add
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/09/29 03:21:31	1.27
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/10/11 22:16:19	1.28
@@ -847,14 +847,15 @@
                             (p (and (not (equal p (slime-lisp-package))) p)))
                        (slime-read-package-name "Package: " p))))
   (with-current-buffer (slime-output-buffer)
-    (let ((unfinished-input (slime-repl-current-input)))
+    (let ((previouse-point (- (point) slime-repl-input-start-mark)))
       (destructuring-bind (name prompt-string)
           (slime-repl-shortcut-eval `(swank:set-package ,package))
         (setf (slime-lisp-package) name)
         (setf (slime-lisp-package-prompt-string) prompt-string)
         (setf slime-buffer-package name)
         (slime-repl-insert-prompt)
-        (insert unfinished-input)))))
+        (when (plusp previouse-point)
+          (goto-char (+ previouse-point slime-repl-input-start-mark)))))))
 
 
 ;;;;; History




From trittweiler at common-lisp.net  Mon Oct 12 08:02:22 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Mon, 12 Oct 2009 04:02:22 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MxFrK-0004on-A4@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
	* slime.el: Update copyright.


--- /project/slime/cvsroot/slime/slime.el	2009/10/10 07:56:37	1.1225
+++ /project/slime/cvsroot/slime/slime.el	2009/10/12 08:02:21	1.1226
@@ -3,6 +3,9 @@
 ;;;; License
 ;;     Copyright (C) 2003  Eric Marsden, Luke Gorrie, Helmut Eller
 ;;     Copyright (C) 2004,2005,2006  Luke Gorrie, Helmut Eller
+;;     Copyright (C) 2007,2008,2009  Helmut Eller, Tobias C. Rittweiler
+;;
+;;     For a detailed list of contributors, see the manual.
 ;;
 ;;     This program is free software; you can redistribute it and/or
 ;;     modify it under the terms of the GNU General Public License as
@@ -26,22 +29,27 @@
 ;; main features are:
 ;;
 ;;   A socket-based communication/RPC interface between Emacs and
-;;   Lisp.
+;;   Lisp, enabling introspection and remote development.
 ;;
 ;;   The `slime-mode' minor-mode complementing `lisp-mode'. This new
 ;;   mode includes many commands for interacting with the Common Lisp
 ;;   process.
 ;;
-;;   Common Lisp debugger written in Emacs Lisp. The debugger pops up
+;;   A Common Lisp debugger written in Emacs Lisp. The debugger pops up
 ;;   an Emacs buffer similar to the Emacs/Elisp debugger.
 ;;
+;;   A Common Lisp inspector to interactively look at run-time data.
+;;
 ;;   Trapping compiler messages and creating annotations in the source
 ;;   file on the appropriate forms.
 ;;
-;; SLIME is compatible with GNU Emacs 21, 22, 23 and XEmacs 21. In
-;; order to run SLIME requires a supporting Lisp server called
-;; Swank. Swank is distributed with slime.el and will automatically be
-;; started in a normal installation.
+;; SLIME is compatible with GNU Emacs 22, and 23; the maintainers do
+;; not use XEmacs, and hence do not cater for its support. Patches
+;; tend to be accepted, though.
+;;
+;; In order to run SLIME, a supporting Lisp server called Swank is
+;; required. Swank is distributed with slime.el and will automatically
+;; be started in a normal installation.
 
 
 ;;;; Dependencies and setup
--- /project/slime/cvsroot/slime/ChangeLog	2009/10/10 07:56:37	1.1871
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/12 08:02:22	1.1872
@@ -1,3 +1,7 @@
+2009-10-12  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el: Update copyright.
+
 2009-10-10  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* slime.el (slime-length=): Fix (slime-length= '() 0).




From trittweiler at common-lisp.net  Wed Oct 14 17:29:15 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Wed, 14 Oct 2009 13:29:15 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1My7f1-0003e4-Tx@common-lisp.net>

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

Modified Files:
	ChangeLog slime-sprof.el 
Log Message:
	* slime-sprof.el (slime-sprof-browser-mode-map): Make
	`slime-parent-map' its parent.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/11 22:16:19	1.254
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/14 17:29:15	1.255
@@ -1,3 +1,8 @@
+2009-10-14  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-sprof.el (slime-sprof-browser-mode-map): Make
+	`slime-parent-map' its parent.
+
 2009-10-12  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-repl.el (slime-repl-set-package): Don't double unfinished input
--- /project/slime/cvsroot/slime/contrib/slime-sprof.el	2009/10/09 14:57:45	1.3
+++ /project/slime/cvsroot/slime/contrib/slime-sprof.el	2009/10/14 17:29:15	1.4
@@ -20,8 +20,11 @@
   "Mode for browsing profiler data\
 \\<slime-sprof-browser-mode-map>\
 \\{slime-sprof-browser-mode-map}"
+  :syntax-table lisp-mode-syntax-table
   (setq buffer-read-only t))
 
+(set-keymap-parent slime-sprof-browser-mode-map slime-parent-map)
+
 (slime-define-keys slime-sprof-browser-mode-map
   ("h" 'describe-mode)
   ("q" 'bury-buffer)




From sboukarev at common-lisp.net  Thu Oct 15 13:10:10 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Thu, 15 Oct 2009 09:10:10 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MyQ5q-0003lC-1Q@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-current-package): Return REPL's package,
if other are unavailable and if slime-repl is loaded.


--- /project/slime/cvsroot/slime/ChangeLog	2009/10/12 08:02:22	1.1872
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/15 13:10:09	1.1873
@@ -1,3 +1,8 @@
+2009-10-15  Stas Boukarev  <stassats at gmail.com>
+
+	* slime.el (slime-current-package): Return REPL's package,
+	if other are unavailable and if slime-repl is loaded.
+
 2009-10-12  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* slime.el: Update copyright.
--- /project/slime/cvsroot/slime/slime.el	2009/10/12 08:02:21	1.1226
+++ /project/slime/cvsroot/slime/slime.el	2009/10/15 13:10:09	1.1227
@@ -2258,7 +2258,9 @@
   (or slime-buffer-package
       (save-restriction
         (widen)
-        (slime-find-buffer-package))))
+        (slime-find-buffer-package))
+      (when (fboundp 'slime-lisp-package)
+        (slime-lisp-package))))
 
 (defvar slime-find-buffer-package-function 'slime-search-buffer-package
   "*Function to use for `slime-find-buffer-package'.  




From heller at common-lisp.net  Thu Oct 15 16:40:38 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 15 Oct 2009 12:40:38 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MyTNW-0003bk-9a@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-current-package): Move REPL stuff to contrib.
* slime-repl.el (slime-repl-find-buffer-package): New function.
(slime-repl-init): Initialize slime-find-buffer-package-function.

--- /project/slime/cvsroot/slime/ChangeLog	2009/10/15 13:10:09	1.1873
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/15 16:40:37	1.1874
@@ -1,3 +1,7 @@
+2009-10-15  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-current-package): Move REPL stuff to contrib.
+
 2009-10-15  Stas Boukarev  <stassats at gmail.com>
 
 	* slime.el (slime-current-package): Return REPL's package,
--- /project/slime/cvsroot/slime/slime.el	2009/10/15 13:10:09	1.1227
+++ /project/slime/cvsroot/slime/slime.el	2009/10/15 16:40:38	1.1228
@@ -43,9 +43,8 @@
 ;;   Trapping compiler messages and creating annotations in the source
 ;;   file on the appropriate forms.
 ;;
-;; SLIME is compatible with GNU Emacs 22, and 23; the maintainers do
-;; not use XEmacs, and hence do not cater for its support. Patches
-;; tend to be accepted, though.
+;; SLIME should work with Emacs 22 and 23.  If it works on XEmacs,
+;; consider yourself lucky.
 ;;
 ;; In order to run SLIME, a supporting Lisp server called Swank is
 ;; required. Swank is distributed with slime.el and will automatically
@@ -2258,9 +2257,7 @@
   (or slime-buffer-package
       (save-restriction
         (widen)
-        (slime-find-buffer-package))
-      (when (fboundp 'slime-lisp-package)
-        (slime-lisp-package))))
+        (slime-find-buffer-package))))
 
 (defvar slime-find-buffer-package-function 'slime-search-buffer-package
   "*Function to use for `slime-find-buffer-package'.  




From heller at common-lisp.net  Thu Oct 15 16:40:38 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 15 Oct 2009 12:40:38 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MyTNW-0003c3-NV@common-lisp.net>

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

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
* slime.el (slime-current-package): Move REPL stuff to contrib.
* slime-repl.el (slime-repl-find-buffer-package): New function.
(slime-repl-init): Initialize slime-find-buffer-package-function.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/14 17:29:15	1.255
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/15 16:40:38	1.256
@@ -1,3 +1,8 @@
+2009-10-15  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-repl.el (slime-repl-find-buffer-package): New function.
+	(slime-repl-init): Initialize slime-find-buffer-package-function.
+
 2009-10-14  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-sprof.el (slime-sprof-browser-mode-map): Make
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/10/11 22:16:19	1.28
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/10/15 16:40:38	1.29
@@ -1551,9 +1551,14 @@
      t)
     (t nil)))
 
+(defun slime-repl-find-buffer-package ()
+  (or (slime-search-buffer-package)
+      (slime-lisp-package)))
+
 (defun slime-repl-init ()
   (add-hook 'slime-event-hooks 'slime-repl-event-hook-function)
-  (add-hook 'slime-connected-hook 'slime-repl-connected-hook-function))
+  (add-hook 'slime-connected-hook 'slime-repl-connected-hook-function)
+  (setq slime-find-buffer-package-function 'slime-repl-find-buffer-package))
 
 (defun slime-repl-remove-hooks ()
   (remove-hook 'slime-event-hooks 'slime-repl-event-hook-function)




From trittweiler at common-lisp.net  Mon Oct 19 10:01:51 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Mon, 19 Oct 2009 06:01:51 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1Mzp3n-0001AN-9L@common-lisp.net>

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

Modified Files:
	swank.lisp ChangeLog 
Log Message:
	* swank.lisp (without-printing-errors): New macro.
	(to-string): Use it.
	(to-line): Use it, too. This fixes printing error occuring during
	inspecting to prevent the inspector from displaying something
	useful.

	Reported by xristos at suspicious.org.


--- /project/slime/cvsroot/slime/swank.lisp	2009/10/09 23:05:12	1.663
+++ /project/slime/cvsroot/slime/swank.lisp	2009/10/19 10:01:50	1.664
@@ -1952,18 +1952,42 @@
         (let ((*readtable* *buffer-readtable*))
           (call-with-syntax-hooks fun)))))
 
+(defmacro without-printing-errors ((&key object stream
+                                        (msg "<<error printing object>>"))
+                                  &body body)
+  "Catches errors during evaluation of BODY and prints MSG instead."
+  `(handler-case (progn , at body) 
+     (serious-condition ()
+       ,(cond ((and stream object)
+               (let ((gstream (gensym "STREAM+")))
+                 `(let ((,gstream ,stream))
+                    (print-unreadable-object (,object ,gstream :type t :identity t)
+                      (write-string ,msg ,gstream)))))
+              (stream
+               `(write-string ,msg ,stream))
+              (object
+               `(with-output-to-string (s)
+                  (print-unreadable-object (,object s :type t :identity t)
+                    (write-string ,msg  s))))
+              (t msg)))))
+
 (defun to-string (object)
   "Write OBJECT in the *BUFFER-PACKAGE*.
 The result may not be readable. Handles problems with PRINT-OBJECT methods
 gracefully."
   (with-buffer-syntax ()
     (let ((*print-readably* nil))
-      (handler-case
-          (prin1-to-string object)
-        (error ()
-          (with-output-to-string (s)
-            (print-unreadable-object (object s :type t :identity t)
-              (princ "<<error printing object>>" s))))))))
+      (without-printing-errors (:object object :stream nil)
+        (prin1-to-string object)))))
+
+(defun to-line  (object &optional (width 75))
+  "Print OBJECT to a single line. Return the string."
+  (without-printing-errors (:object object :stream nil)
+    (call/truncated-output-to-string
+     width
+     (lambda (*standard-output*)
+       (write object :right-margin width :lines 1))
+     "..")))
 
 (defun from-string (string)
   "Read string in the *BUFFER-PACKAGE*"
@@ -2300,6 +2324,7 @@
                    (replace buffer ellipsis :start1 fill-pointer)
                    (return-from buffer-full buffer)))))
         (let ((stream (make-output-stream #'write-output)))
+          
           (funcall function stream)
           (finish-output stream)
           (subseq buffer 0 fill-pointer))))))
@@ -3374,13 +3399,7 @@
         (format nil "#~D=~A" pos string)
         string)))
 
-;; Print OBJECT to a single line. Return the string.
-(defun to-line  (object &optional (width 75))
-  (call/truncated-output-to-string
-   width
-   (lambda (*standard-output*)
-     (write object :right-margin width :lines 1))
-   ".."))
+
 
 (defun content-range (list start end)
   (typecase list
--- /project/slime/cvsroot/slime/ChangeLog	2009/10/15 16:40:37	1.1874
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/19 10:01:50	1.1875
@@ -1,3 +1,13 @@
+2009-10-19  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp (without-printing-errors): New macro.
+	(to-string): Use it.
+	(to-line): Use it, too. This fixes printing error occuring during
+	inspecting to prevent the inspector from displaying something
+	useful.
+
+	Reported by xristos at suspicious.org.
+
 2009-10-15  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-current-package): Move REPL stuff to contrib.




From sboukarev at common-lisp.net  Mon Oct 19 22:46:24 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 19 Oct 2009 18:46:24 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N00zg-0006YK-HD@common-lisp.net>

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

Modified Files:
	slime-asdf.el swank-asdf.lisp 
Log Message:
* contrib/slime-asdf.el (slime-open-system): New command for opening all files
in a system.
* contrib/swank-asdf.lisp (asdf-system-files): New function for listing all
files in a system.


--- /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/03/04 17:59:19	1.8
+++ /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/10/19 22:46:24	1.9
@@ -68,6 +68,15 @@
    `(swank:operate-on-system-for-emacs ,system ,operation , at keyword-args)
    #'slime-compilation-finished))
 
+(defun slime-open-system (name &optional load)
+  (interactive (list (slime-read-system-name)
+                     (y-or-n-p "Load it? ")))
+  (when load
+    (slime-load-system name))
+  (slime-repl-shortcut-eval-async
+   `(swank:asdf-system-files ,name)
+   (lambda (files) (mapc 'find-file files))))
+
 (defslime-repl-shortcut slime-repl-load/force-system ("force-load-system")
   (:handler (lambda ()
               (interactive)
--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2008/10/23 21:28:03	1.7
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/10/19 22:46:24	1.8
@@ -64,4 +64,17 @@
           (list-all-systems-in-central-registry)
           :test #'string=))
 
+(defun asdf-module-files (module)
+  (mapcan #'(lambda (component)
+              (typecase component
+                (asdf:cl-source-file
+                 (list (asdf:component-pathname component)))
+                (asdf:module
+                 (asdf-module-files component))))
+          (asdf:module-components module)))
+
+(defslimefun asdf-system-files (system)
+  (mapcar #'namestring
+          (asdf-module-files (asdf:find-system system))))
+
 (provide :swank-asdf)




From sboukarev at common-lisp.net  Mon Oct 19 23:13:28 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 19 Oct 2009 19:13:28 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N01Ps-00082u-5v@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-list-threads): Update information before
setting the mode, otherwise it messes up current connection.
* doc/slime.texi: fix typo.


--- /project/slime/cvsroot/slime/ChangeLog	2009/10/19 10:01:50	1.1875
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/19 23:13:27	1.1876
@@ -1,3 +1,10 @@
+2009-10-19  Stas Boukarev  <stassats at gmail.com>
+
+	* slime.el (slime-list-threads): Update information before
+	setting the mode, otherwise it messes up current connection.
+
+	* doc/slime.texi: fix typo.
+
 2009-10-19  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* swank.lisp (without-printing-errors): New macro.
--- /project/slime/cvsroot/slime/slime.el	2009/10/15 16:40:38	1.1228
+++ /project/slime/cvsroot/slime/slime.el	2009/10/19 23:13:27	1.1229
@@ -1060,18 +1060,17 @@
      (with-current-buffer standard-output
        (prog1 (progn , at body)
          (assert (eq (current-buffer) standard-output))
-         (setq buffer-read-only t)
          (slime-init-popup-buffer vars%)
+         (setq buffer-read-only t)
          (set-window-point (slime-display-popup-buffer ,(or select 'nil))
-                           (point))
-         (current-buffer)))))
+                           (point))))))
 
 (put 'slime-with-popup-buffer 'lisp-indent-function 1)
 
 (defun slime-make-popup-buffer (name buffer-vars)
   "Return a temporary buffer called NAME.
 The buffer also uses the minor-mode `slime-popup-buffer-mode'."
-  (with-current-buffer (or (get-buffer name) (get-buffer-create name))
+  (with-current-buffer (get-buffer-create name)
     (kill-all-local-variables)
     (setq buffer-read-only nil)
     (erase-buffer)
@@ -6227,9 +6226,9 @@
   (interactive)
   (let ((name slime-threads-buffer-name))
     (slime-with-popup-buffer (name nil t)
+      (slime-update-threads-buffer)
       (slime-thread-control-mode)
-      (setq slime-popup-buffer-quit-function 'slime-quit-threads-buffer)
-      (slime-update-threads-buffer))))
+      (setq slime-popup-buffer-quit-function 'slime-quit-threads-buffer))))
 
 (defun slime-quit-threads-buffer (&optional _)
   (slime-eval-async `(swank:quit-thread-browser))




From sboukarev at common-lisp.net  Mon Oct 19 23:14:44 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 19 Oct 2009 19:14:44 -0400
Subject: [slime-cvs] CVS slime/doc
Message-ID: <E1N01R6-00085n-MS@common-lisp.net>

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

Modified Files:
	slime.texi 
Log Message:
doc/slime.texi: Really commit a typo fix.


--- /project/slime/cvsroot/slime/doc/slime.texi	2009/10/10 13:44:34	1.82
+++ /project/slime/cvsroot/slime/doc/slime.texi	2009/10/19 23:14:44	1.83
@@ -12,7 +12,7 @@
 @set EDITION 3.0-alpha
 @set SLIMEVER 3.0-alpha
 @c @set UPDATED @today{}
- at set UPDATED @code{$Date: 2009/10/10 13:44:34 $}
+ at set UPDATED @code{$Date: 2009/10/19 23:14:44 $}
 @set TITLE SLIME User Manual
 @settitle @value{TITLE}, version @value{EDITION}
 
@@ -780,7 +780,7 @@
 which binds @kbd{C-c s} to the function @code{slime-selector}.
 
 Alternatively, if you want to assign or change a key binding in just a
-particular slime mode, you can use the @code{global-set-key} function
+particular slime mode, you can use the @code{define-key} function
 in your @file{~/.emacs} file like this:
 @example
 (define-key slime-repl-mode-map (kbd "C-c ;") 




From sboukarev at common-lisp.net  Mon Oct 19 23:23:46 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 19 Oct 2009 19:23:46 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N01Zq-0000jk-3O@common-lisp.net>

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

Modified Files:
	ChangeLog swank-sbcl.lisp swank.lisp 
Log Message:
* swank-sbcl.lisp (thread-description): Remove it and supporting code,
because it didn't really work.

* swank.lisp (with-thread-description): Remove unused macro.


--- /project/slime/cvsroot/slime/ChangeLog	2009/10/19 23:13:27	1.1876
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/19 23:23:45	1.1877
@@ -1,5 +1,10 @@
 2009-10-19  Stas Boukarev  <stassats at gmail.com>
 
+	* swank-sbcl.lisp (thread-description): Remove it and supporting code,
+	because it didn't really work.
+
+	* swank.lisp (with-thread-description): Remove unused macro.
+
 	* slime.el (slime-list-threads): Update information before
 	setting the mode, otherwise it messes up current connection.
 
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/09/26 23:24:50	1.252
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/10/19 23:23:45	1.253
@@ -1380,43 +1380,9 @@
 
   (defimplementation thread-status (thread)
     (if (sb-thread:thread-alive-p thread)
-        "RUNNING"
-        "STOPPED"))
-  #+#.(swank-backend::sbcl-with-weak-hash-tables)
-  (progn
-    (defparameter *thread-description-map*
-      (make-weak-key-hash-table))
-
-    (defvar *thread-descr-map-lock*
-      (sb-thread:make-mutex :name "thread description map lock"))
-    
-    (defimplementation thread-description (thread)
-      (sb-thread:with-mutex (*thread-descr-map-lock*)
-        (or (gethash thread *thread-description-map*)
-            (short-backtrace thread 6 10))))
-
-    (defimplementation set-thread-description (thread description)
-      (sb-thread:with-mutex (*thread-descr-map-lock*)
-        (setf (gethash thread *thread-description-map*) description)))
-
-    (defun short-backtrace (thread start count)
-      (let ((self (current-thread))
-            (tag (get-internal-real-time)))
-        (sb-thread:interrupt-thread
-         thread
-         (lambda ()
-           (let* ((frames (nthcdr start (sb-debug:backtrace-as-list count))))
-             (send self (cons tag frames)))))
-        (handler-case
-            (sb-ext:with-timeout 0.1
-              (let ((frames (cdr (receive-if (lambda (msg) 
-                                               (eq (car msg) tag)))))
-                    (*print-pretty* nil))
-                (format nil "~{~a~^ <- ~}" (mapcar #'car frames))))
-          (sb-ext:timeout () ""))))
-
-    )
-
+        "Running"
+        "Stopped"))
+  
   (defimplementation make-lock (&key name)
     (sb-thread:make-mutex :name name))
 
--- /project/slime/cvsroot/slime/swank.lisp	2009/10/19 10:01:50	1.664
+++ /project/slime/cvsroot/slime/swank.lisp	2009/10/19 23:23:45	1.665
@@ -1593,8 +1593,6 @@
 
 ;;; Channels
 
-(progn
-
 (defvar *channels* '())
 (defvar *channel-counter* 0)
 
@@ -1705,30 +1703,7 @@
            (unless ok
              (send-to-remote-channel remote `(:read-aborted ,tag)))))))))
 
-)
-
-(defun call-with-thread-description (description thunk)
-  ;; For `M-x slime-list-threads': Display what threads
-  ;; created by swank are currently doing.
-  (flet ((request-to-string (req)
-           (remove #\Newline
-                   (string-trim '(#\Space #\Tab)
-                                (prin1-to-string req))))
-         (truncate-string (str n)
-           (format nil "~A..." (subseq str 0 (min (length str) n)))))
-    (let* ((thread (current-thread))
-           (old-description (thread-description thread)))
-      (set-thread-description thread 
-                              (truncate-string (request-to-string description)
-                                               55))
-      (unwind-protect (funcall thunk)
-        (set-thread-description thread old-description)))))
-
-
-
-
-(defmacro with-thread-description (description &body body)
-  `(call-with-thread-description ,description #'(lambda () , at body)))
+
 
 (defun decode-message (stream)
   "Read an S-expression from STREAM using the SLIME protocol."




From sboukarev at common-lisp.net  Tue Oct 20 10:43:52 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Tue, 20 Oct 2009 06:43:52 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N0CC0-0008Cu-RO@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
Forgot to commit changelog.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/15 16:40:38	1.256
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/20 10:43:52	1.257
@@ -1,3 +1,11 @@
+2009-10-19  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-asdf.el (slime-open-system): New command for opening all files
+	in a system.
+
+	* swank-asdf.lisp (asdf-system-files): New function for listing all
+	files in a system.
+
 2009-10-15  Helmut Eller  <heller at common-lisp.net>
 
 	* slime-repl.el (slime-repl-find-buffer-package): New function.




From msimmons at common-lisp.net  Tue Oct 20 16:13:02 2009
From: msimmons at common-lisp.net (CVS User msimmons)
Date: Tue, 20 Oct 2009 12:13:02 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N0HKY-0005tL-B1@common-lisp.net>

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

Modified Files:
	swank-lispworks.lisp ChangeLog 
Log Message:
* swank-lispworks.lisp (call-without-interrupts): Discourage use.
(interesting-frame-p): Never show open frame bogons.


--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/09/28 11:33:43	1.133
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2009/10/20 16:13:02	1.134
@@ -170,7 +170,7 @@
                                (mp:process-interrupt self handler)))))
 
 (defimplementation call-without-interrupts (fn)
-  (lw:without-interrupts (funcall fn)))
+  (error "Don't use without-interrupts -- consider without-slime-interrupts instead."))
   
 (defimplementation getpid ()
   #+win32 (win32:get-current-process-id)
@@ -327,7 +327,6 @@
         ((dbg::binding-frame-p frame) dbg:*print-binding-frames*)
         ((dbg::handler-frame-p frame) dbg:*print-handler-frames*)
         ((dbg::restart-frame-p frame) dbg:*print-restart-frames*)
-        ((dbg::open-frame-p frame) dbg:*print-open-frames*)
         (t nil)))
 
 (defun nth-next-frame (frame n)
--- /project/slime/cvsroot/slime/ChangeLog	2009/10/19 23:23:45	1.1877
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/20 16:13:02	1.1878
@@ -1,3 +1,8 @@
+2009-10-20  Martin Simmons  <martin at lispworks.com>
+
+	* swank-lispworks.lisp (call-without-interrupts): Discourage use.
+	(interesting-frame-p): Never show open frame bogons.
+
 2009-10-19  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-sbcl.lisp (thread-description): Remove it and supporting code,




From sboukarev at common-lisp.net  Tue Oct 20 21:28:38 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Tue, 20 Oct 2009 17:28:38 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N0MFy-00011I-Pp@common-lisp.net>

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

Modified Files:
	ChangeLog slime-parse.el 
Log Message:
* contrib/slime-parse.el (slime-parse-sexp-at-point): Remove unused flet.
Check for existence of a sexp before trying to parse, not after.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/20 10:43:52	1.257
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/20 21:28:38	1.258
@@ -1,3 +1,8 @@
+2009-10-20  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-parse.el (slime-parse-sexp-at-point): Remove unused flet.
+	Check for existence of a sexp before trying to parse, not after.
+
 2009-10-19  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-asdf.el (slime-open-system): New command for opening all files
--- /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/07/11 19:20:18	1.23
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/10/20 21:28:38	1.24
@@ -33,26 +33,19 @@
 If SKIP-BLANKS-P is true, leading whitespaces &c are skipped.
 "
   (interactive "p") (or n (setq n 1))
-  (flet ((sexp-at-point (first-choice)
-           (let ((string (if (eq first-choice :symbol-first)
-                             (or (slime-symbol-at-point)
-                                 (thing-at-point 'sexp))
-                             (or (thing-at-point 'sexp)
-                                 (slime-symbol-at-point)))))
-             (if string (substring-no-properties string) nil))))
-    (save-excursion
-      (when skip-blanks-p ; e.g. `( foo bat)' where point is after ?\(.
-        (slime-forward-blanks))
-      (let ((result nil))
-        (dotimes (i n)
-          (push (slime-sexp-at-point) result)
-          ;; Skip current sexp
-          (ignore-errors (forward-sexp) (slime-forward-blanks))
-          ;; Is there an additional sexp in front of us?
-          (save-excursion
-            (unless (slime-point-moves-p (ignore-errors (forward-sexp)))
-              (return))))
-        (nreverse result)))))
+  (save-excursion
+    (when skip-blanks-p ; e.g. `( foo bat)' where point is after ?\(.
+      (slime-forward-blanks))
+    (let ((result nil))
+      (dotimes (i n)
+        ;; Is there an additional sexp in front of us?
+        (save-excursion
+          (unless (slime-point-moves-p (ignore-errors (forward-sexp)))
+            (return)))
+        (push (slime-sexp-at-point) result)
+        ;; Skip current sexp
+        (ignore-errors (forward-sexp) (slime-forward-blanks)))
+      (nreverse result))))
 
 (defun slime-has-symbol-syntax-p (string)
   (if (and string (not (zerop (length string))))
@@ -128,8 +121,7 @@
             (let* ((args (slime-parse-sexp-at-point n))
                    (arg-specs (mapcar #'slime-make-form-spec-from-string args)))
               (setq current-forms (cons `(,name , at arg-specs) old-forms))))
-          (values current-forms current-indices current-points)
-          ))))
+          (values current-forms current-indices current-points)))))
 
 ;;; FIXME: We display "(proclaim (optimize ...))" instead of the
 ;;; correct "(proclaim '(optimize ...))".




From sboukarev at common-lisp.net  Wed Oct 21 13:26:36 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 21 Oct 2009 09:26:36 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N0bD2-0003M4-2h@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
* contrib/slime-asdf.el (slime-browse-system): New command for browsing
	files in asdf using Dired.
* contrib/swank-asdf.lisp (asdf-system-loaded-p): New function.


--- /project/slime/cvsroot/slime/ChangeLog	2009/10/20 16:13:02	1.1878
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/21 13:26:35	1.1879
@@ -1,3 +1,7 @@
+2009-10-21  Stas Boukarev  <stassats at gmail.com>
+
+	* doc/slime.texi (ASDF): Document new commands.
+
 2009-10-20  Martin Simmons  <martin at lispworks.com>
 
 	* swank-lispworks.lisp (call-without-interrupts): Discourage use.




From sboukarev at common-lisp.net  Wed Oct 21 13:26:36 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 21 Oct 2009 09:26:36 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N0bD2-0003MF-A5@common-lisp.net>

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

Modified Files:
	ChangeLog slime-asdf.el swank-asdf.lisp 
Log Message:
* contrib/slime-asdf.el (slime-browse-system): New command for browsing
	files in asdf using Dired.
* contrib/swank-asdf.lisp (asdf-system-loaded-p): New function.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/20 21:28:38	1.258
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/21 13:26:36	1.259
@@ -1,3 +1,10 @@
+2009-10-21  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-asdf.el (slime-browse-system): New command for browsing
+	files in asdf using Dired.
+
+	* swank-asdf.lisp (asdf-system-loaded-p): New function.
+
 2009-10-20  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-parse.el (slime-parse-sexp-at-point): Remove unused flet.
--- /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/10/19 22:46:24	1.9
+++ /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/10/21 13:26:36	1.10
@@ -69,14 +69,33 @@
    #'slime-compilation-finished))
 
 (defun slime-open-system (name &optional load)
-  (interactive (list (slime-read-system-name)
-                     (y-or-n-p "Load it? ")))
-  (when load
+  "Open all files in an ASDF system."
+  (interactive (list (slime-read-system-name)))
+  (when (or load
+            (and (called-interactively-p)
+                 (not (slime-eval `(swank:asdf-system-loaded-p ,name)))
+                 (y-or-n-p "Load it? ")))
     (slime-load-system name))
-  (slime-repl-shortcut-eval-async
+  (slime-eval-async
    `(swank:asdf-system-files ,name)
    (lambda (files) (mapc 'find-file files))))
 
+(defun slime-browse-system (name &optional load)
+  "Browse files in an ASDF system using Dired."
+  (interactive (list (slime-read-system-name)))
+  (when (or load
+            (and (called-interactively-p)
+                 (not (slime-eval `(swank:asdf-system-loaded-p ,name)))
+                 (y-or-n-p "Load it? ")))
+    (slime-load-system name))
+  (slime-eval-async
+   `(swank:asdf-system-files ,name)
+   (lexical-let ((name name))
+     (lambda (files)
+       (when files
+         (dired (cons (format "ASDF system %s" name)
+                      files)))))))
+
 (defslime-repl-shortcut slime-repl-load/force-system ("force-load-system")
   (:handler (lambda ()
               (interactive)
@@ -114,6 +133,18 @@
               (slime-oos (slime-read-system-name) "COMPILE-OP" :force t)))
   (:one-liner "Recompile (but not load) an ASDF system."))
 
+(defslime-repl-shortcut slime-repl-open-system ("open-system")
+  (:handler (lambda ()
+              (interactive)
+              (call-interactively 'slime-open-system)))
+  (:one-liner "Open all files in an ASDF system."))
+
+(defslime-repl-shortcut slime-repl-browse-system ("browse-system")
+  (:handler (lambda ()
+              (interactive)
+              (call-interactively 'slime-browse-system)))
+  (:one-liner "Browse files in an ASDF system using Dired."))
+
 (defun slime-asdf-on-connect ()
   (slime-eval-async '(swank:swank-require :swank-asdf)))
 
--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/10/19 22:46:24	1.8
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/10/21 13:26:36	1.9
@@ -77,4 +77,8 @@
   (mapcar #'namestring
           (asdf-module-files (asdf:find-system system))))
 
+(defslimefun asdf-system-loaded-p (system)
+  (gethash 'asdf:load-op
+           (asdf::component-operation-times (asdf:find-system system))))
+
 (provide :swank-asdf)




From sboukarev at common-lisp.net  Wed Oct 21 13:38:33 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 21 Oct 2009 09:38:33 -0400
Subject: [slime-cvs] CVS slime/doc
Message-ID: <E1N0bOb-0004BS-FM@common-lisp.net>

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

Modified Files:
	slime.texi 
Log Message:
* doc/slime.texi (ASDF): Document new commands.


--- /project/slime/cvsroot/slime/doc/slime.texi	2009/10/19 23:14:44	1.83
+++ /project/slime/cvsroot/slime/doc/slime.texi	2009/10/21 13:38:33	1.84
@@ -12,7 +12,7 @@
 @set EDITION 3.0-alpha
 @set SLIMEVER 3.0-alpha
 @c @set UPDATED @today{}
- at set UPDATED @code{$Date: 2009/10/19 23:14:44 $}
+ at set UPDATED @code{$Date: 2009/10/21 13:38:33 $}
 @set TITLE SLIME User Manual
 @settitle @value{TITLE}, version @value{EDITION}
 
@@ -2520,6 +2520,10 @@
 @cmditem{slime-load-system NAME}
 Compile and load an ASDF system.  The default system name is taken
 from the first file matching *.asd in the current directory.
+ at cmditem{slime-open-system NAME &optional LOAD}
+Open all files in a system, optionally load it if LOAD is non-nil.
+ at cmditem{slime-browse-system NAME &optional LOAD}
+Browse files in a system using Dired, optionally load it if LOAD is non-nil.
 @end table
 
 The package also installs some new REPL shortcuts (@pxref{Shortcuts}):
@@ -2533,6 +2537,10 @@
 Recompile (but not load) an ASDF system.
 @item force-load-system
 Recompile and load an ASDF system.
+ at item open-system
+Open all files in a system.
+ at item browse-system
+Browse files in a system using Dired.
 @end table
 
 @node Banner




From sboukarev at common-lisp.net  Wed Oct 21 14:32:57 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 21 Oct 2009 10:32:57 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N0cFF-00007m-8p@common-lisp.net>

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

Modified Files:
	ChangeLog slime-asdf.el 
Log Message:
* contrib/slime-asdf.el (slime-browse-system): Open the parent directory of
an .asd file, not just files defined in it.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/21 13:26:36	1.259
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/21 14:32:57	1.260
@@ -1,5 +1,10 @@
 2009-10-21  Stas Boukarev  <stassats at gmail.com>
 
+	* slime-asdf.el (slime-browse-system): Open the parent directory of
+	an .asd file, not just files defined in it.
+
+2009-10-21  Stas Boukarev  <stassats at gmail.com>
+
 	* slime-asdf.el (slime-browse-system): New command for browsing
 	files in asdf using Dired.
 
--- /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/10/21 13:26:36	1.10
+++ /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/10/21 14:32:57	1.11
@@ -80,21 +80,16 @@
    `(swank:asdf-system-files ,name)
    (lambda (files) (mapc 'find-file files))))
 
-(defun slime-browse-system (name &optional load)
+(defun slime-browse-system (name)
   "Browse files in an ASDF system using Dired."
   (interactive (list (slime-read-system-name)))
-  (when (or load
-            (and (called-interactively-p)
-                 (not (slime-eval `(swank:asdf-system-loaded-p ,name)))
-                 (y-or-n-p "Load it? ")))
-    (slime-load-system name))
-  (slime-eval-async
-   `(swank:asdf-system-files ,name)
-   (lexical-let ((name name))
-     (lambda (files)
-       (when files
-         (dired (cons (format "ASDF system %s" name)
-                      files)))))))
+  (slime-eval-async 
+   `(cl:directory-namestring
+     (cl:truename
+      (asdf:system-definition-pathname (asdf:find-system ,name))))
+   (lambda (directory)
+     (when directory
+       (dired directory)))))
 
 (defslime-repl-shortcut slime-repl-load/force-system ("force-load-system")
   (:handler (lambda ()




From sboukarev at common-lisp.net  Wed Oct 21 14:32:57 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 21 Oct 2009 10:32:57 -0400
Subject: [slime-cvs] CVS slime/doc
Message-ID: <E1N0cFF-00007z-Es@common-lisp.net>

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

Modified Files:
	slime.texi 
Log Message:
* contrib/slime-asdf.el (slime-browse-system): Open the parent directory of
an .asd file, not just files defined in it.


--- /project/slime/cvsroot/slime/doc/slime.texi	2009/10/21 13:38:33	1.84
+++ /project/slime/cvsroot/slime/doc/slime.texi	2009/10/21 14:32:57	1.85
@@ -12,7 +12,7 @@
 @set EDITION 3.0-alpha
 @set SLIMEVER 3.0-alpha
 @c @set UPDATED @today{}
- at set UPDATED @code{$Date: 2009/10/21 13:38:33 $}
+ at set UPDATED @code{$Date: 2009/10/21 14:32:57 $}
 @set TITLE SLIME User Manual
 @settitle @value{TITLE}, version @value{EDITION}
 
@@ -2522,8 +2522,8 @@
 from the first file matching *.asd in the current directory.
 @cmditem{slime-open-system NAME &optional LOAD}
 Open all files in a system, optionally load it if LOAD is non-nil.
- at cmditem{slime-browse-system NAME &optional LOAD}
-Browse files in a system using Dired, optionally load it if LOAD is non-nil.
+ at cmditem{slime-browse-system NAME}
+Browse files in a system using Dired.
 @end table
 
 The package also installs some new REPL shortcuts (@pxref{Shortcuts}):




From trittweiler at common-lisp.net  Wed Oct 21 14:37:08 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Wed, 21 Oct 2009 10:37:08 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N0cJI-0000By-RA@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
	Make M-x slime-changelog-date work.

	* slime.el (slime-changelog-date): Make the function be callable
	interactively.


--- /project/slime/cvsroot/slime/ChangeLog	2009/10/21 13:26:35	1.1879
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/21 14:37:08	1.1880
@@ -1,3 +1,10 @@
+2009-10-21  Tobias C. Rittweiler <tcr at freebits.de>
+
+	Make M-x slime-changelog-date work.
+
+	* slime.el (slime-changelog-date): Make the function be callable
+	interactively.
+
 2009-10-21  Stas Boukarev  <stassats at gmail.com>
 
 	* doc/slime.texi (ASDF): Document new commands.
--- /project/slime/cvsroot/slime/slime.el	2009/10/19 23:13:27	1.1229
+++ /project/slime/cvsroot/slime/slime.el	2009/10/21 14:37:08	1.1230
@@ -115,16 +115,20 @@
        'common-lisp-indent-function))
 
 (eval-and-compile
-  (defun slime-changelog-date ()
+  (defun slime-changelog-date (&optional interactivep)
     "Return the datestring of the latest entry in the ChangeLog file.
 Return nil if the ChangeLog file cannot be found."
-    (let ((changelog (concat slime-path "ChangeLog")))
-      (if (file-exists-p changelog)
-          (with-temp-buffer 
-            (insert-file-contents-literally changelog nil 0 100)
-            (goto-char (point-min))
-            (symbol-name (read (current-buffer))))
-        nil))))
+    (interactive "p")
+    (let ((changelog (concat slime-path "ChangeLog"))
+          (date nil))
+      (when (file-exists-p changelog)
+        (with-temp-buffer 
+          (insert-file-contents-literally changelog nil 0 100)
+          (goto-char (point-min))
+          (setq date (symbol-name (read (current-buffer))))))
+      (when interactivep
+        (message "Slime ChangeLog dates %s." date))
+      date)))
 
 (defvar slime-protocol-version nil)
 (setq slime-protocol-version




From sboukarev at common-lisp.net  Wed Oct 21 19:38:49 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 21 Oct 2009 15:38:49 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N0h1F-0004jC-7S@common-lisp.net>

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

Modified Files:
	ChangeLog slime-asdf.el swank-asdf.lisp 
Log Message:
* contrib/slime-asdf.el (slime-open-system): Open files in another window.
* contrib/swank-asdf.lisp (asdf-system-files): Put file with the same name as
a system at the first place.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/21 14:32:57	1.260
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/21 19:38:49	1.261
@@ -2,6 +2,10 @@
 
 	* slime-asdf.el (slime-browse-system): Open the parent directory of
 	an .asd file, not just files defined in it.
+	(slime-open-system): Open files in another window.
+
+	* swank-asdf.lisp (asdf-system-files): Put file with the same name as
+	a system at the first place.
 
 2009-10-21  Stas Boukarev  <stassats at gmail.com>
 
--- /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/10/21 14:32:57	1.11
+++ /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/10/21 19:38:49	1.12
@@ -78,7 +78,11 @@
     (slime-load-system name))
   (slime-eval-async
    `(swank:asdf-system-files ,name)
-   (lambda (files) (mapc 'find-file files))))
+   (lambda (files)
+     (when files
+       (let ((files (nreverse files)))
+         (find-file-other-window (car files))
+         (mapc 'find-file (cdr files)))))))
 
 (defun slime-browse-system (name)
   "Browse files in an ASDF system using Dired."
--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/10/21 13:26:36	1.9
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/10/21 19:38:49	1.10
@@ -74,8 +74,14 @@
           (asdf:module-components module)))
 
 (defslimefun asdf-system-files (system)
-  (mapcar #'namestring
-          (asdf-module-files (asdf:find-system system))))
+  (let* ((files (mapcar #'namestring
+                        (asdf-module-files (asdf:find-system system))))
+         (main-file (find system files
+                          :test #'string-equal
+                          :key #'pathname-name)))
+    (if main-file
+        (cons main-file (remove main-file files :test #'equalp))
+        files)))
 
 (defslimefun asdf-system-loaded-p (system)
   (gethash 'asdf:load-op




From trittweiler at common-lisp.net  Fri Oct 23 09:34:56 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 23 Oct 2009 05:34:56 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N1GXw-0005kH-PI@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
	When ever Slime seems to get stuck (e.g. after some character
	encoding confusion), `M-x slime-reset' should hopefully bring it
	into a functional state again.

	* slime.el (slime-reset): Erase connection buffer.


--- /project/slime/cvsroot/slime/slime.el	2009/10/21 14:37:08	1.1230
+++ /project/slime/cvsroot/slime/slime.el	2009/10/23 09:34:56	1.1231
@@ -2487,10 +2487,14 @@
   (slime-net-send sexp (slime-connection)))
 
 (defun slime-reset ()
-  "Clear all pending continuations."
+  "Clear all pending continuations and erase connection buffer."
   (interactive)
   (setf (slime-rex-continuations) '())
-  (mapc #'kill-buffer (sldb-buffers)))
+  (mapc #'kill-buffer (sldb-buffers))
+  ;; Due to character encoding errors, a half-processed RPC result may
+  ;; get stuck in the connection buffer and keep Slime choking.
+  (slime-with-connection-buffer ()
+    (erase-buffer)))
 
 (defun slime-send-sigint ()
   (interactive)
--- /project/slime/cvsroot/slime/ChangeLog	2009/10/21 14:37:08	1.1880
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/23 09:34:56	1.1881
@@ -1,3 +1,11 @@
+2009-10-23  Tobias C. Rittweiler <tcr at freebits.de>
+
+	When ever Slime seems to get stuck (e.g. after some character
+	encoding confusion), `M-x slime-reset' should hopefully bring it
+	into a functional state again.
+
+	* slime.el (slime-reset): Erase connection buffer.
+
 2009-10-21  Tobias C. Rittweiler <tcr at freebits.de>
 
 	Make M-x slime-changelog-date work.




From trittweiler at common-lisp.net  Fri Oct 23 19:40:14 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 23 Oct 2009 15:40:14 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N1Pzi-0002nd-S1@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
	Restarts in SLDB are now numbered reversely. The rationale is that
	always-existing restarts are likely to be associated with the same
	number now.

	* slime.el (sldb-insert-restarts): Number restart reversely.
	(sldb-restart-number-for-swank): New; recompute the unreversed
	number for the swank side.
	(sldb-restart-number-at-point): Previously `sldb-restart-at-point'.
	(sldb-invoke-restart): Adapted accordingly.


--- /project/slime/cvsroot/slime/slime.el	2009/10/23 09:34:56	1.1231
+++ /project/slime/cvsroot/slime/slime.el	2009/10/23 19:40:14	1.1232
@@ -5485,7 +5485,7 @@
     (eval `(defun ,fname ()
              ,docstring
              (interactive)
-             (sldb-invoke-restart ,number)))
+             (sldb-invoke-restart (sldb-restart-number-for-swank ,number))))
     (define-key sldb-mode-map (number-to-string number) fname)))
 
 
@@ -5630,17 +5630,20 @@
 RESTARTS should be a list ((NAME DESCRIPTION) ...)."
   (let* ((len (length restarts))
          (end (if count (min (+ start count) len) len)))
+    ;; N.B. We deliberately number the restarts reversely so always
+    ;; existing restarts (e.g. SWANK's RETRY restart) will likely get
+    ;; the same numeric value.
     (loop for (name string) in (subseq restarts start end)
-          for number from start do
-          (unless (bolp) (insert "\n"))
-          (slime-insert-propertized
-           `(, at nil restart-number ,number
-                   sldb-default-action sldb-invoke-restart
-                   mouse-face highlight)
-           " " (in-sldb-face restart-number (number-to-string number))
-           ": ["  (in-sldb-face restart-type name) "] "
-           (in-sldb-face restart string))
-          (insert "\n"))
+          for number from (1- len) downto start
+          do (unless (bolp) (insert "\n"))
+             (slime-insert-propertized
+               `(, at nil sldb-restart-number ,number
+                       sldb-default-action sldb-invoke-restart
+                       mouse-face highlight)
+               " " (in-sldb-face restart-number (number-to-string number))
+               ": ["  (in-sldb-face restart-type name) "] "
+               (in-sldb-face restart string))
+             (insert "\n"))
     (when (< end len)
       (let ((pos (point)))
         (slime-insert-propertized
@@ -5654,6 +5657,10 @@
     (delete-region position (1+ (line-end-position)))
     (sldb-insert-restarts restarts start nil)))
 
+;;; Fix up the reverse ordering. Cf. `sldb-insert-restarts'.
+(defun sldb-restart-number-for-swank (restart-number)
+  (- (length sldb-restarts) (1+ restart-number)))
+
 (defun sldb-frame.string (frame)
   (destructuring-bind (_ str &optional _) frame str))
 
@@ -5732,9 +5739,11 @@
 
 ;;;;;; SLDB examining text props
 
-(defun sldb-restart-at-point ()
-  (or (get-text-property (point) 'restart-number)
-      (error "No restart at point")))
+(defun sldb-restart-number-at-point ()
+  (let ((n (get-text-property (point) 'sldb-restart-number)))
+    (unless n
+      (error "No restart at point"))
+    (sldb-restart-number-for-swank n)))
 
 (defun sldb-frame-number-at-point ()
   (let ((frame (get-text-property (point) 'frame)))
@@ -6129,10 +6138,10 @@
 
 (defun sldb-invoke-restart (&optional number)
   "Invoke a restart.
-Optional NUMBER specifies the restart to invoke, otherwise
-use the restart at point."
+Optional NUMBER (index into `sldb-restarts') specifies the
+restart to invoke, otherwise use the restart at point."
   (interactive)
-  (let ((restart (or number (sldb-restart-at-point))))
+  (let ((restart (or number (sldb-restart-number-at-point))))
     (slime-rex ()
         ((list 'swank:invoke-nth-restart-for-emacs sldb-level restart))
       ((:ok value) (message "Restart returned: %s" value))
--- /project/slime/cvsroot/slime/ChangeLog	2009/10/23 09:34:56	1.1881
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/23 19:40:14	1.1882
@@ -1,5 +1,17 @@
 2009-10-23  Tobias C. Rittweiler <tcr at freebits.de>
 
+	Restarts in SLDB are now numbered reversely. The rationale is that
+	always-existing restarts are likely to be associated with the same
+	number now.
+
+	* slime.el (sldb-insert-restarts): Number restart reversely.
+	(sldb-restart-number-for-swank): New; recompute the unreversed
+	number for the swank side.
+	(sldb-restart-number-at-point): Previously `sldb-restart-at-point'.
+	(sldb-invoke-restart): Adapted accordingly.
+
+2009-10-23  Tobias C. Rittweiler <tcr at freebits.de>
+
 	When ever Slime seems to get stuck (e.g. after some character
 	encoding confusion), `M-x slime-reset' should hopefully bring it
 	into a functional state again.




From heller at common-lisp.net  Sat Oct 24 08:00:28 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 24 Oct 2009 04:00:28 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N1bY4-00054b-9L@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (sldb-insert-restarts): Insert the proper numbers for
the --more-- button.
(sldb-restart-number-at-point): Rename back to
sldb-restart-at-point.  Don't use
confisingly-verbose-names-for-no-good-reason.
(sldb-restart-number-for-swank): Deleted.

--- /project/slime/cvsroot/slime/ChangeLog	2009/10/23 19:40:14	1.1882
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/24 08:00:28	1.1883
@@ -1,3 +1,12 @@
+2009-10-24  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (sldb-insert-restarts): Insert the proper numbers for
+	the --more-- button.
+	(sldb-restart-number-at-point): Rename back to
+	sldb-restart-at-point.  Don't use
+	confisingly-verbose-names-for-no-good-reason.
+	(sldb-restart-number-for-swank): Deleted.
+
 2009-10-23  Tobias C. Rittweiler <tcr at freebits.de>
 
 	Restarts in SLDB are now numbered reversely. The rationale is that
--- /project/slime/cvsroot/slime/slime.el	2009/10/23 19:40:14	1.1232
+++ /project/slime/cvsroot/slime/slime.el	2009/10/24 08:00:28	1.1233
@@ -5485,7 +5485,7 @@
     (eval `(defun ,fname ()
              ,docstring
              (interactive)
-             (sldb-invoke-restart (sldb-restart-number-for-swank ,number))))
+             (sldb-invoke-restart (- (length sldb-restarts) number 1))))
     (define-key sldb-mode-map (number-to-string number) fname)))
 
 
@@ -5630,17 +5630,15 @@
 RESTARTS should be a list ((NAME DESCRIPTION) ...)."
   (let* ((len (length restarts))
          (end (if count (min (+ start count) len) len)))
-    ;; N.B. We deliberately number the restarts reversely so always
-    ;; existing restarts (e.g. SWANK's RETRY restart) will likely get
-    ;; the same numeric value.
     (loop for (name string) in (subseq restarts start end)
-          for number from (1- len) downto start
+          for number from start  
+          for i downfrom (- len start 1)
           do (unless (bolp) (insert "\n"))
              (slime-insert-propertized
-               `(, at nil sldb-restart-number ,number
+               `(, at nil restart ,number
                        sldb-default-action sldb-invoke-restart
                        mouse-face highlight)
-               " " (in-sldb-face restart-number (number-to-string number))
+               " " (in-sldb-face restart-number (number-to-string i))
                ": ["  (in-sldb-face restart-type name) "] "
                (in-sldb-face restart string))
              (insert "\n"))
@@ -5657,10 +5655,6 @@
     (delete-region position (1+ (line-end-position)))
     (sldb-insert-restarts restarts start nil)))
 
-;;; Fix up the reverse ordering. Cf. `sldb-insert-restarts'.
-(defun sldb-restart-number-for-swank (restart-number)
-  (- (length sldb-restarts) (1+ restart-number)))
-
 (defun sldb-frame.string (frame)
   (destructuring-bind (_ str &optional _) frame str))
 
@@ -5739,11 +5733,9 @@
 
 ;;;;;; SLDB examining text props
 
-(defun sldb-restart-number-at-point ()
-  (let ((n (get-text-property (point) 'sldb-restart-number)))
-    (unless n
-      (error "No restart at point"))
-    (sldb-restart-number-for-swank n)))
+(defun sldb-restart-at-point ()
+  (or (get-text-property (point) 'restart)
+      (error "No restart at point")))
 
 (defun sldb-frame-number-at-point ()
   (let ((frame (get-text-property (point) 'frame)))
@@ -6141,7 +6133,7 @@
 Optional NUMBER (index into `sldb-restarts') specifies the
 restart to invoke, otherwise use the restart at point."
   (interactive)
-  (let ((restart (or number (sldb-restart-number-at-point))))
+  (let ((restart (or number (sldb-restart-at-point))))
     (slime-rex ()
         ((list 'swank:invoke-nth-restart-for-emacs sldb-level restart))
       ((:ok value) (message "Restart returned: %s" value))




From trittweiler at common-lisp.net  Sat Oct 24 09:33:17 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 24 Oct 2009 05:33:17 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N1czt-0003Hz-7z@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
	New command C-M-, to go to previous xref location.

	[Old command C-M-. to go to next xref location.]

	Xref buffers are not automatically selected anymore; it's more
	ergonomic to cycle through them via C-M-. and C-M-, from
	within the source buffer.

	* slime.el (slime-search-property): Simplify slightly.
	(slime-find-next-note): Use it.
	(slime-find-previous-note): Use it, too.
	(slime-find-note): Deleted.
	(slime-editing-keys): Add C-M-,.
	(slime-previous-location-function): New variable.
	(slime-previous-location): New command.
	(slime-with-xref-buffer): Do not select Xref buffer.
	(slime-show-xref-buffer): Adapted accordingly.
	(slime-goto-next-xref): Highlight current item on C-M-. and C-M-,.
	(slime-goto-previous-xref): New.
	(slime-highlight-sexp): Renamed from `sldb-highlight-sexp'.
	(slime-highlight-line): New.


--- /project/slime/cvsroot/slime/slime.el	2009/10/24 08:00:28	1.1233
+++ /project/slime/cvsroot/slime/slime.el	2009/10/24 09:33:16	1.1234
@@ -596,6 +596,7 @@
     ;; Misc
     ("\C-c\C-u"   slime-undefine-function)
     (,(kbd "C-M-.")   slime-next-location)
+    (,(kbd "C-M-,")   slime-previous-location)
     ;; Obsolete, redundant bindings
     ("\C-c\C-i" slime-complete-symbol)
     ;;("\M-*" pop-tag-mark) ; almost to clever
@@ -3670,25 +3671,12 @@
 (defun slime-find-next-note ()
   "Go to the next position with the `slime-note' text property.
 Retuns the note overlay if such a position is found, otherwise nil."
-  (slime-find-note 'next-single-char-property-change))
+  (slime-search-property 'slime-note))
 
 (defun slime-find-previous-note ()
-  "Go to the next position with the `slime' text property.
+  "Go to the next position with the `slime-note' text property.
 Retuns the note overlay if such a position is found, otherwise nil."
-  (slime-find-note 'previous-single-char-property-change))
-
-(defun slime-find-note (next-candidate-fn)
-  "Seek out the beginning of a note.
-NEXT-CANDIDATE-FN is called to find each new position for consideration.
-Return the note overlay if such a position is found, otherwise nil."
-  (let ((origin (point))
-        (overlay))
-    (loop do (goto-char (funcall next-candidate-fn (point) 'slime-note))
-          until (or (setq overlay (slime-note-at-point))
-                    (eobp)
-                    (bobp)))
-    (unless overlay (goto-char origin))
-    overlay))
+  (slime-search-property 'slime-note t))
 
 
 ;;;; Arglist Display
@@ -4863,7 +4851,10 @@
   "Execute BODY in a xref buffer, then show that buffer."
   `(let ((xref-buffer-name% (format "*slime xref[%s: %s]*" 
                                     ,xref-type ,symbol)))
-     (slime-with-popup-buffer (xref-buffer-name% ,package t t ,emacs-snapshot)
+     ;; Do not select the xref buffer; it's most often more ergonomic
+     ;; to move through the xref buffer implicitly from the source
+     ;; buffer by using C-M-. and C-M-,.
+     (slime-with-popup-buffer (xref-buffer-name% ,package t nil ,emacs-snapshot)
        (slime-xref-mode)
        (slime-set-truncate-lines)
        (erase-buffer)
@@ -4889,14 +4880,16 @@
   (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 ))))
+    (setq slime-previous-location-function 'slime-goto-previous-xref)
+    (setq slime-xref-last-buffer (current-buffer))))
 
 (defvar slime-next-location-function nil
   "Function to call for going to the next location.")
 
+(defvar slime-previous-location-function nil
+  "Function to call for going to the previous location.")
+
 (defvar slime-xref-last-buffer nil
   "The most recent XREF results buffer.
 This is used by `slime-goto-next-xref'")
@@ -5036,35 +5029,49 @@
   (interactive)
   (let ((location (slime-xref-location-at-point)))
     (slime-show-source-location location)))
-      
+
 (defun slime-goto-next-xref (&optional backward)
   "Goto the next cross-reference location."
-  (let ((location 
-         (and (buffer-live-p slime-xref-last-buffer)
-              (with-current-buffer slime-xref-last-buffer
-                (slime-search-property 'slime-location backward)))))
-    (cond ((slime-location-p location)
-           (slime-pop-to-location location))
-          ((null location)
-           (message "No more xrefs."))
-          (t ; error
-           (slime-goto-next-xref backward)))))
+  (if (not (buffer-live-p slime-xref-last-buffer))
+      (error "No XREF buffer alive.")
+    (multiple-value-bind (location pos)
+        (with-current-buffer slime-xref-last-buffer
+          (values (slime-search-property 'slime-location backward)
+                  (point)))
+      (cond ((slime-location-p location)
+             (slime-pop-to-location location)
+             ;; We do this here because changing the location can take
+             ;; a while when Emacs needs to read a file from disk.
+             (with-current-buffer slime-xref-last-buffer
+               (slime-show-buffer-position pos)
+               (slime-highlight-line 0.35)))
+            ((null location)
+             (message (if backward "No previous xref" "No next xref.")))
+            (t ; error location
+             (slime-goto-next-xref backward))))))
+
+(defun slime-goto-previous-xref ()
+  "Goto the previous cross-reference location."
+  (slime-goto-next-xref t))
 
 (defun slime-search-property (prop &optional backward)
   "Search the next text range where PROP is non-nil.
 If found, return the value of the property; otherwise return nil.
 If BACKWARD is non-nil, search backward."
-  (let ((fun (cond (backward #'previous-single-char-property-change)
-                   (t #'next-single-char-property-change)))
-        (test (lambda () (get-text-property (point) prop)))
-        (start (point)))
+  (let ((next-candidate (if backward 
+                            #'previous-single-char-property-change
+                            #'next-single-char-property-change))
+        (start (point))
+        (prop-value))
     (while (progn 
-             (goto-char (funcall fun (point) prop))
-             (not (or (funcall test) 
+             (goto-char (funcall next-candidate (point) prop))
+             (not (or (setq prop-value (get-text-property (point) prop)) 
                       (eobp) 
                       (bobp)))))
-    (or (funcall test)
-        (progn (goto-char start) nil))))
+    (if prop-value
+        prop-value
+     (goto-char start)
+     nil)))
 
 (defun slime-next-location ()
   "Go to the next location, depending on context.
@@ -5074,6 +5081,14 @@
     (error "No context for finding locations."))
   (funcall slime-next-location-function))
 
+(defun slime-previous-location ()
+  "Go to the previous location, depending on context.
+When displaying XREF information, this goes to the previous reference."
+  (interactive)
+  (when (null slime-previous-location-function)
+    (error "No context for finding locations."))
+  (funcall slime-previous-location-function))
+
 (defun slime-recompile-xref (&optional raw-prefix-arg)
   (interactive "P")
   (let ((slime-compilation-policy (slime-compute-policy raw-prefix-arg)))
@@ -5791,7 +5806,7 @@
       (select-window window)
       (goto-char position)
       (ecase recenter
-        (top (recenter 0))
+        (top    (recenter 0))
         (center (recenter))
         ((nil)
          (unless (pos-visible-in-window-p)
@@ -5924,15 +5939,20 @@
 (defun slime-show-source-location (source-location &optional no-highlight-p)
   (save-selected-window   ; show the location, but don't hijack focus.
     (slime-goto-source-location source-location)
-    (unless no-highlight-p (sldb-highlight-sexp))
+    (unless no-highlight-p (slime-highlight-sexp))
     (slime-show-buffer-position (point))))
 
-(defun sldb-highlight-sexp (&optional start end)
+(defun slime-highlight-sexp (&optional start end)
   "Highlight the first sexp after point."
   (let ((start (or start (point)))
 	(end (or end (save-excursion (ignore-errors (forward-sexp)) (point)))))
     (slime-flash-region start end)))
 
+(defun slime-highlight-line (&optional timeout)
+  (slime-flash-region (+ (line-beginning-position) (current-indentation)) 
+                      (line-end-position)
+                      timeout))
+
 
 ;;;;;; SLDB toggle details
 
--- /project/slime/cvsroot/slime/ChangeLog	2009/10/24 08:00:28	1.1883
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/24 09:33:16	1.1884
@@ -1,3 +1,27 @@
+2009-10-24  Tobias C. Rittweiler <tcr at freebits.de>
+
+	New command C-M-, to go to previous xref location.
+
+	[Old command C-M-. to go to next xref location.]
+
+	Xref buffers are not automatically selected anymore; it's more
+	ergonomic to cycle through them via C-M-. and C-M-, from
+	within the source buffer.
+
+	* slime.el (slime-search-property): Simplify slightly.
+	(slime-find-next-note): Use it.
+	(slime-find-previous-note): Use it, too.
+	(slime-find-note): Deleted.
+	(slime-editing-keys): Add C-M-,.
+	(slime-previous-location-function): New variable.
+	(slime-previous-location): New command.
+	(slime-with-xref-buffer): Do not select Xref buffer.
+	(slime-show-xref-buffer): Adapted accordingly.
+	(slime-goto-next-xref): Highlight current item on C-M-. and C-M-,.
+	(slime-goto-previous-xref): New.
+	(slime-highlight-sexp): Renamed from `sldb-highlight-sexp'.
+	(slime-highlight-line): New.
+
 2009-10-24  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (sldb-insert-restarts): Insert the proper numbers for




From trittweiler at common-lisp.net  Sat Oct 24 09:47:46 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 24 Oct 2009 05:47:46 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N1dDu-0004Hu-NA@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
	* slime.el (slime-search-property): Add parameter to get value at
	point propery changed.
	(slime-find-next-note): Use it.
	(slime-find-previous-note): Ditto.


--- /project/slime/cvsroot/slime/slime.el	2009/10/24 09:33:16	1.1234
+++ /project/slime/cvsroot/slime/slime.el	2009/10/24 09:47:46	1.1235
@@ -3671,12 +3671,12 @@
 (defun slime-find-next-note ()
   "Go to the next position with the `slime-note' text property.
 Retuns the note overlay if such a position is found, otherwise nil."
-  (slime-search-property 'slime-note))
+  (slime-search-property 'slime-note nil #'slime-note-at-point))
 
 (defun slime-find-previous-note ()
   "Go to the next position with the `slime-note' text property.
 Retuns the note overlay if such a position is found, otherwise nil."
-  (slime-search-property 'slime-note t))
+  (slime-search-property 'slime-note t #'slime-note-at-point))
 
 
 ;;;; Arglist Display
@@ -5054,18 +5054,22 @@
   "Goto the previous cross-reference location."
   (slime-goto-next-xref t))
 
-(defun slime-search-property (prop &optional backward)
+(defun slime-search-property (prop &optional backward prop-value-fn)
   "Search the next text range where PROP is non-nil.
-If found, return the value of the property; otherwise return nil.
+If found, call PROP-VALUE-FN if given, or return the value of the
+property; otherwise return nil.
 If BACKWARD is non-nil, search backward."
   (let ((next-candidate (if backward 
                             #'previous-single-char-property-change
                             #'next-single-char-property-change))
+        (prop-value-fn  (or prop-value-fn
+                            #'(lambda ()
+                                (get-text-property (point) prop))))
         (start (point))
         (prop-value))
     (while (progn 
              (goto-char (funcall next-candidate (point) prop))
-             (not (or (setq prop-value (get-text-property (point) prop)) 
+             (not (or (setq prop-value (funcall prop-value-fn)) 
                       (eobp) 
                       (bobp)))))
     (if prop-value
--- /project/slime/cvsroot/slime/ChangeLog	2009/10/24 09:33:16	1.1884
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/24 09:47:46	1.1885
@@ -1,5 +1,12 @@
 2009-10-24  Tobias C. Rittweiler <tcr at freebits.de>
 
+	* slime.el (slime-search-property): Add parameter to get value at
+	point propery changed.
+	(slime-find-next-note): Use it.
+	(slime-find-previous-note): Ditto.
+
+2009-10-24  Tobias C. Rittweiler <tcr at freebits.de>
+
 	New command C-M-, to go to previous xref location.
 
 	[Old command C-M-. to go to next xref location.]




From trittweiler at common-lisp.net  Sat Oct 24 11:05:15 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 24 Oct 2009 07:05:15 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N1eQt-0000ga-IK@common-lisp.net>

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

Modified Files:
	swank.lisp ChangeLog 
Log Message:
	* swank.lisp (xref): Deal with non-yet-interned names gracefully.


--- /project/slime/cvsroot/slime/swank.lisp	2009/10/19 23:23:45	1.665
+++ /project/slime/cvsroot/slime/swank.lisp	2009/10/24 11:05:15	1.666
@@ -1968,7 +1968,7 @@
   "Read string in the *BUFFER-PACKAGE*"
   (with-buffer-syntax ()
     (let ((*read-suppress* nil))
-      (read-from-string string))))
+      (values (read-from-string string)))))
 
 (defun parse-string (string package)
   "Read STRING in PACKAGE."
@@ -3231,7 +3231,7 @@
 (defslimefun find-definitions-for-emacs (name)
   "Return a list ((DSPEC LOCATION) ...) of definitions for NAME.
 DSPEC is a string and LOCATION a source location. NAME is a string."
-  (multiple-value-bind (sexp error) (ignore-errors (values (from-string name)))
+  (multiple-value-bind (sexp error) (ignore-errors (from-string name))
     (unless error
       (mapcar #'xref>elisp (find-definitions sexp)))))
 
@@ -3248,12 +3248,12 @@
     (:callees (list-callees symbol))))
 
 (defslimefun xref (type name)
-  (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)))))
+  (multiple-value-bind (sexp error) (ignore-errors (from-string name))
+    (unless error
+      (let ((xrefs  (xref-doit type sexp)))
+        (if (eq xrefs :not-implemented)
+            :not-implemented
+            (mapcar #'xref>elisp xrefs))))))
 
 (defslimefun xrefs (types name)
   (loop for type in types
--- /project/slime/cvsroot/slime/ChangeLog	2009/10/24 09:47:46	1.1885
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/24 11:05:15	1.1886
@@ -1,5 +1,9 @@
 2009-10-24  Tobias C. Rittweiler <tcr at freebits.de>
 
+	* swank.lisp (xref): Deal with non-yet-interned names gracefully.
+
+2009-10-24  Tobias C. Rittweiler <tcr at freebits.de>
+
 	* slime.el (slime-search-property): Add parameter to get value at
 	point propery changed.
 	(slime-find-next-note): Use it.




From trittweiler at common-lisp.net  Sat Oct 24 11:32:18 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 24 Oct 2009 07:32:18 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N1er4-0001wX-Vr@common-lisp.net>

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

Modified Files:
	swank-ccl.lisp ChangeLog 
Log Message:
	* swank-ccl.lisp (who-specializes): Do not signal an error if
	argument does not name a class.


--- /project/slime/cvsroot/slime/swank-ccl.lisp	2009/10/06 20:12:03	1.7
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2009/10/24 11:32:18	1.8
@@ -303,11 +303,14 @@
    :test 'equal))
 
 (defimplementation who-specializes (class)
-  (delete-duplicates
-   (mapcar (lambda (m) 
-             (car (find-definitions m)))
-           (ccl:specializer-direct-methods (if (symbolp class) (find-class class) class)))
-   :test 'equal))
+  (when (symbolp class)
+    (setq class (find-class class nil)))
+  (when class
+    (delete-duplicates
+     (mapcar (lambda (m) 
+               (car (find-definitions m)))
+             (ccl:specializer-direct-methods class))
+     :test 'equal)))
 
 (defimplementation list-callees (name)
   (remove-duplicates
--- /project/slime/cvsroot/slime/ChangeLog	2009/10/24 11:05:15	1.1886
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/24 11:32:18	1.1887
@@ -1,5 +1,10 @@
 2009-10-24  Tobias C. Rittweiler <tcr at freebits.de>
 
+	* swank-ccl.lisp (who-specializes): Do not signal an error if
+	argument does not name a class.
+
+2009-10-24  Tobias C. Rittweiler <tcr at freebits.de>
+
 	* swank.lisp (xref): Deal with non-yet-interned names gracefully.
 
 2009-10-24  Tobias C. Rittweiler <tcr at freebits.de>




From trittweiler at common-lisp.net  Sun Oct 25 18:44:36 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sun, 25 Oct 2009 14:44:36 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N284y-0004du-5h@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
	Revert the reversed numbering of restarts in sldb.

	New command `sldb-cycle' ([tab]) in sldb will cycle between
	restart list and backtrace.

	Make sldb-invoke-restart-by-name case-insensitive.

	* slime.el (sldb-mode-map): Bind Tab to `sldb-cycle'.
	(sldb-restart-list-start-marker): New variable.
	(sldb-setup): Store marker in it.
	(sldb-cycle): New command to cycle between restart list and
	backtrace.
	(sldb-invoke-restart-by-name): Make completion case-insensitive.
	(sldb-insert-restarts): Revert to old behaviour.


--- /project/slime/cvsroot/slime/slime.el	2009/10/24 09:47:46	1.1235
+++ /project/slime/cvsroot/slime/slime.el	2009/10/25 18:44:35	1.1236
@@ -5385,7 +5385,10 @@
    "Current debug level (recursion depth) displayed in buffer.")
 
  (defvar sldb-backtrace-start-marker nil
-   "Marker placed at the beginning of the backtrace text.")
+   "Marker placed at the first frame of the backtrace.")
+
+ (defvar sldb-restart-list-start-marker nil
+  "Marker placed at the first restart in the restart list.")
 
  (defvar sldb-continuations nil
    "List of ids for pending continuation."))
@@ -5463,13 +5466,15 @@
 (set-keymap-parent sldb-mode-map slime-parent-map)
 
 (slime-define-keys sldb-mode-map
-  ("h"    'describe-mode)
-  ("v"    'sldb-show-source)
+
   ((kbd "RET") 'sldb-default-action)
   ("\C-m"      'sldb-default-action)
   ([return] 'sldb-default-action)
   ([mouse-2]  'sldb-default-action/mouse)
   ([follow-link] 'mouse-face)
+  ("\C-i" 'sldb-cycle)
+  ("h"    'describe-mode)
+  ("v"    'sldb-show-source)
   ("e"    'sldb-eval-in-frame)
   ("d"    'sldb-pprint-eval-in-frame)
   ("D"    'sldb-disassemble)
@@ -5504,7 +5509,7 @@
     (eval `(defun ,fname ()
              ,docstring
              (interactive)
-             (sldb-invoke-restart (- (length sldb-restarts) number 1))))
+             (sldb-invoke-restart ,number)))
     (define-key sldb-mode-map (number-to-string number) fname)))
 
 
@@ -5569,7 +5574,8 @@
       (setq sldb-restarts restarts)
       (setq sldb-continuations conts)
       (sldb-insert-condition condition)
-      (insert "\n\n" (in-sldb-face section "Restarts:"))
+      (insert "\n\n" (in-sldb-face section "Restarts:") "\n")
+      (setq sldb-restart-list-start-marker (point-marker))
       (sldb-insert-restarts restarts 0 sldb-initial-restart-limit)
       (insert "\n" (in-sldb-face section "Backtrace:") "\n")
       (setq sldb-backtrace-start-marker (point-marker))
@@ -5651,13 +5657,11 @@
          (end (if count (min (+ start count) len) len)))
     (loop for (name string) in (subseq restarts start end)
           for number from start  
-          for i downfrom (- len start 1)
-          do (unless (bolp) (insert "\n"))
-             (slime-insert-propertized
+          do (slime-insert-propertized
                `(, at nil restart ,number
                        sldb-default-action sldb-invoke-restart
                        mouse-face highlight)
-               " " (in-sldb-face restart-number (number-to-string i))
+               " " (in-sldb-face restart-number (number-to-string number))
                ": ["  (in-sldb-face restart-type name) "] "
                (in-sldb-face restart string))
              (insert "\n"))
@@ -5904,6 +5908,17 @@
       (let ((fn (get-text-property (point) 'sldb-default-action)))
 	(if fn (funcall fn))))))
 
+(defun sldb-cycle ()
+  "Cycle between restart list and backtrace."
+  (interactive)
+  (let ((pt (point)))
+    (cond ((< pt sldb-restart-list-start-marker)
+           (goto-char sldb-restart-list-start-marker))
+          ((< pt sldb-backtrace-start-marker)
+           (goto-char sldb-backtrace-start-marker))
+          (t
+           (goto-char sldb-restart-list-start-marker)))))
+
 (defun sldb-end-of-backtrace ()
   "Fetch the entire backtrace and go to the last frame."
   (interactive)
@@ -6164,10 +6179,10 @@
       ((:abort)))))
 
 (defun sldb-invoke-restart-by-name (restart-name)
-  (interactive (list (completing-read "Restart: "
-                                      sldb-restarts nil t
-                                      ""
-                                      'sldb-invoke-restart-by-name)))
+  (interactive (list (let ((completion-ignore-case t))
+                       (completing-read "Restart: " sldb-restarts nil t
+                                        ""
+                                        'sldb-invoke-restart-by-name))))
   (sldb-invoke-restart (position restart-name sldb-restarts 
                                  :test 'string= :key 'first)))
 
--- /project/slime/cvsroot/slime/ChangeLog	2009/10/24 11:32:18	1.1887
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/25 18:44:35	1.1888
@@ -1,3 +1,20 @@
+2009-10-25  Tobias C. Rittweiler <tcr at freebits.de>
+
+	Revert the reversed numbering of restarts in sldb.
+
+	New command `sldb-cycle' ([tab]) in sldb will cycle between
+	restart list and backtrace.
+
+	Make sldb-invoke-restart-by-name case-insensitive.
+
+	* slime.el (sldb-mode-map): Bind Tab to `sldb-cycle'.
+	(sldb-restart-list-start-marker): New variable.
+	(sldb-setup): Store marker in it.
+	(sldb-cycle): New command to cycle between restart list and
+	backtrace.
+	(sldb-invoke-restart-by-name): Make completion case-insensitive.
+	(sldb-insert-restarts): Revert to old behaviour.
+
 2009-10-24  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* swank-ccl.lisp (who-specializes): Do not signal an error if




From trittweiler at common-lisp.net  Mon Oct 26 19:17:00 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Mon, 26 Oct 2009 15:17:00 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N2V3s-0004tM-SQ@common-lisp.net>

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

Modified Files:
	test.sh ChangeLog 
Log Message:
	* test.sh: Shebang on bash, not just on sh.


--- /project/slime/cvsroot/slime/test.sh	2008/10/26 21:17:58	1.21
+++ /project/slime/cvsroot/slime/test.sh	2009/10/26 19:17:00	1.22
@@ -1,4 +1,4 @@
-#!/bin/sh
+#!/bin/bash
 
 # Run the SLIME test suite inside screen, saving the results to a file.
 
--- /project/slime/cvsroot/slime/ChangeLog	2009/10/25 18:44:35	1.1888
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/26 19:17:00	1.1889
@@ -1,3 +1,7 @@
+2009-10-26  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* test.sh: Shebang on bash, not just on sh.
+
 2009-10-25  Tobias C. Rittweiler <tcr at freebits.de>
 
 	Revert the reversed numbering of restarts in sldb.




From heller at common-lisp.net  Tue Oct 27 12:46:32 2009
From: heller at common-lisp.net (CVS User heller)
Date: Tue, 27 Oct 2009 08:46:32 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N2lRY-00088p-GT@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el: Fix some docstrings and comments.

--- /project/slime/cvsroot/slime/ChangeLog	2009/10/26 19:17:00	1.1889
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/27 12:46:32	1.1890
@@ -1,3 +1,7 @@
+2009-10-27  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el: Fix some docstrings and comments.
+
 2009-10-26  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* test.sh: Shebang on bash, not just on sh.
--- /project/slime/cvsroot/slime/slime.el	2009/10/25 18:44:35	1.1236
+++ /project/slime/cvsroot/slime/slime.el	2009/10/27 12:46:32	1.1237
@@ -59,9 +59,6 @@
 
 (eval-and-compile
   (require 'cl)
-  (unless (fboundp 'define-minor-mode)
-    (require 'easy-mmode)
-    (defalias 'define-minor-mode 'easy-mmode-define-minor-mode))
   (when (locate-library "hyperspec")
     (require 'hyperspec)))
 (require 'thingatpt)
@@ -666,8 +663,8 @@
         do (define-key slime-mode-map key command)))
 
 (defun slime-define-both-key-bindings (keymap bindings)
+  "Add BINDINGS to KEYMAP, both unmodified and with control."
   (loop for (char command) in bindings do
-        ;; We bind both unmodified and with control.
         (define-key keymap `[,char] command)
         (unless (equal char ?h)     ; But don't bind C-h
           (define-key keymap `[(control ,char)] command))))
@@ -707,8 +704,7 @@
 ;;;;; Syntactic sugar
 
 (defmacro* when-let ((var value) &rest body)
-  "Evaluate VALUE, and if the result is non-nil bind it to VAR and
-evaluate BODY.
+  "Evaluate VALUE, if the result is non-nil bind it to VAR and eval BODY.
 
 \(fn (VAR VALUE) &rest BODY)"
   `(let ((,var ,value))
@@ -881,9 +877,7 @@
 (defun slime-read-symbol-name (prompt &optional query)
   "Either read a symbol name or choose the one at point.
 The user is prompted if a prefix argument is in effect, if there is no
-symbol at point, or if QUERY is non-nil.
-
-This function avoids mistaking the REPL prompt for a symbol."
+symbol at point, or if QUERY is non-nil."
   (cond ((or current-prefix-arg query (not (slime-symbol-at-point)))
          (slime-read-from-minibuffer prompt (slime-symbol-at-point)))
         (t (slime-symbol-at-point))))
@@ -945,11 +939,16 @@
     (list (previous-single-char-property-change end prop) end)))
 
 (defun slime-curry (fun &rest args)
+  "Partially apply FUN to ARGS.  The result is a new function.
+This idiom is preferred over `lexical-let'."
   `(lambda (&rest more) (apply ',fun (append ',args more))))
 
 (defun slime-rcurry (fun &rest args)
+  "Like `slime-curry' but ARGS on the right are applied."
   `(lambda (&rest more) (apply ',fun (append more ',args))))
 
+
+;; FIXME: Get rid or snapshots.
 ;;;;; Snapshots of current Emacs state
 
 ;;; Window configurations do not save (and hence not restore)
@@ -1170,8 +1169,10 @@
 ;;; these functions. This way users who run Emacs and Lisp on separate
 ;;; machines have a chance to integrate file operations somehow.
 
-(defvar slime-to-lisp-filename-function #'convert-standard-filename)
-(defvar slime-from-lisp-filename-function #'identity)
+(defvar slime-to-lisp-filename-function #'convert-standard-filename
+  "Function to translate Emacs filenames to CL namestrings.")
+(defvar slime-from-lisp-filename-function #'identity
+  "Function to translate CL namestrings to Emacs filenames.")
 
 (defun slime-to-lisp-filename (filename)
   "Translate the string FILENAME to a Lisp filename."
@@ -1197,16 +1198,11 @@
 (defvar slime-lisp-implementations nil
   "*A list of known Lisp implementations.
 The list should have the form: 
-  ((NAME (PROGRAM PROGRAM-ARGS...) &key INIT CODING-SYSTEM ENV) ...)
+  ((NAME (PROGRAM PROGRAM-ARGS...) &key KEYWORD-ARGS) ...)
 
 NAME is a symbol for the implementation.
 PROGRAM and PROGRAM-ARGS are strings used to start the Lisp process.
-INIT is a function that should return a string to load and start
-  Swank. The function will be called with the PORT-FILENAME and ENCODING as
-  arguments.  INIT defaults to `slime-init-command'. 
-CODING-SYSTEM a symbol for the coding system. The default is 
-  slime-net-coding-system
-ENV environment variables for the subprocess (see `process-environment').
+For KEYWORD-ARGS see `slime-start'.
 
 Here's an example: 
  ((cmucl (\"/opt/cmucl/bin/lisp\" \"-quiet\") :init slime-init-command)
@@ -1294,6 +1290,23 @@
                           (buffer "*inferior-lisp*")
                           init-function
                           env)
+  "Start a Lisp process and connect to it.
+This function is intended for programmatic use if `slime' is not
+flexible enough.
+
+PROGRAM and PROGRAM-ARGS are the filename and argument strings
+  for the subprocess.
+INIT is a function that should return a string to load and start
+  Swank. The function will be called with the PORT-FILENAME and ENCODING as
+  arguments.  INIT defaults to `slime-init-command'. 
+CODING-SYSTEM a symbol for the coding system. The default is 
+  slime-net-coding-system
+ENV environment variables for the subprocess (see `process-environment').
+INIT-FUNCTION function to call right after the connection is established.
+BUFFER the name of the buffer to use for the subprocess.
+NAME a symbol to describe the Lisp implementation
+DIRECTORY change to this directory before starting the process.
+"
   (let ((args (list :program program :program-args program-args :buffer buffer 
                     :coding-system coding-system :init init :name name
                     :init-function init-function :env env)))
@@ -1309,7 +1322,7 @@
   (apply #'slime-start options))
 
 (defun slime-connect (host port &optional coding-system)
-  "Connect to a running Swank server. Returns the connection."
+  "Connect to a running Swank server. Return the connection."
   (interactive (list (read-from-minibuffer "Host: " slime-lisp-host)
                      (read-from-minibuffer "Port: " (format "%d" slime-port)
                                            nil t)))
@@ -1324,30 +1337,13 @@
            (slime-dispatching-connection process))
       (slime-setup-connection process))))
 
-;;(defun slime-start-and-load (filename &optional package)
-;;  "Start Slime, if needed, load the current file and set the package."
-;;  (interactive (list (expand-file-name (buffer-file-name))
-;;                     (slime-find-buffer-package)))
-;;  (cond ((slime-connected-p)
-;;         (slime-load-file-set-package filename package))
-;;        (t
-;;         (slime-start-and-init (slime-lisp-options)
-;;                               (slime-curry #'slime-start-and-load 
-;;                                            filename package)))))
-
+;; FIXME: seems redundant
 (defun slime-start-and-init (options fun)
   (let* ((rest (plist-get options :init-function))
          (init (cond (rest `(lambda () (funcall ',rest) (funcall ',fun)))
                      (t fun))))
     (slime-start* (plist-put (copy-list options) :init-function init))))
 
-;;(defun slime-load-file-set-package (filename package)
-;;  (let ((filename (slime-to-lisp-filename filename)))
-;;    (slime-eval-async `(swank:load-file ,filename)
-;;                      (lexical-let ((package package))
-;;                        (lambda (ignored)
-;;                          (slime-repl-set-package package))))))
-
 ;;;;; Start inferior lisp
 ;;;
 ;;; Here is the protocol for starting SLIME:
@@ -1453,7 +1449,8 @@
   (slime-read-port-and-connect process nil))
 
 (defvar slime-inferior-lisp-args nil
-  "A buffer local variable in the inferior proccess.")
+  "A buffer local variable in the inferior proccess.
+See `slime-start'.")
 
 (defun slime-start-swank-server (process args)
   "Start a Swank server on the inferior lisp."
@@ -1467,6 +1464,8 @@
         (process-send-string process str)))))
 
 (defun slime-inferior-lisp-args (process)
+  "Return the initial process arguments.
+See `slime-start'."
   (with-current-buffer (process-buffer process)
     slime-inferior-lisp-args))
 
@@ -1615,9 +1614,9 @@
 The functions are called with the process as their argument.")
 
 (defun slime-secret ()
-  "Finds the magic secret from the user's home directory.
-Returns nil if the file doesn't exist or is empty; otherwise the first
-line of the file."
+  "Find the magic secret from the user's home directory.
+Return nil if the file doesn't exist or is empty; otherwise the
+first line of the file."
   (condition-case err
       (with-temp-buffer
 	(insert-file-contents "~/.slime-secret")
@@ -1662,8 +1661,6 @@
 
 ;;;;; Coding system madness
 
-
-  
 (defun slime-check-coding-system (coding-system)
   "Signal an error if CODING-SYSTEM isn't a valid coding system."
   (interactive)
@@ -1881,6 +1878,7 @@
            (error "Connection closed."))
           (t conn))))
 
+;; FIXME: should be called auto-start
 (defcustom slime-auto-connect 'never
   "Controls auto connection when information from lisp process is needed.
 This doesn't mean it will connect right after Slime is loaded."
@@ -1901,7 +1899,7 @@
         (t nil)))
 
 (defcustom slime-auto-select-connection 'ask
-  "Controls auto selection after the default connection was quited."
+  "Controls auto selection after the default connection was closed."
   :group 'slime-mode
   :type '(choice (const never)
                  (const always)
@@ -1932,8 +1930,6 @@
                    slime-net-processes))
          (p (car tail)))
     (slime-select-connection p)
-;;    (unless (eq major-mode 'slime-repl-mode)
-;;      (setq slime-buffer-connection p))
     (message "Lisp: %s %s" (slime-connection-name p) (process-contact p))))
 
 (defmacro* slime-with-connection-buffer ((&optional process) &rest body)
@@ -1948,7 +1944,6 @@
 
 (put 'slime-with-connection-buffer 'lisp-indent-function 1)
 
-
 (defun slime-compute-connection-state (conn)
   (cond ((null conn) :disconnected) 
         ((slime-stale-connection-p conn) :stale)
@@ -2116,9 +2111,8 @@
 
 ;;;;; Commands on connections
 
-(defun slime-disconnect (&optional connection)
-  "If CONNECTION is non-nil disconnect it, otherwise disconnect
-the current slime connection."
+(defun slime-disconnect ()
+  "Close the current connection."
   (interactive)
   (slime-net-close (or connection (slime-connection))))
 
@@ -2135,7 +2129,7 @@
 
 (defun slime-process (&optional connection)
   "Return the Lisp process for CONNECTION (default `slime-connection').
-Can return nil if there's no process object for the connection."
+Return nil if there's no process object for the connection."
   (let ((proc (slime-inferior-process connection)))
     (if (and proc 
              (memq (process-status proc) '(run stop)))
@@ -2437,7 +2431,6 @@
                                    (error "Invalid channel id: %S %S" id msg))
                                msg))
           ((:emacs-channel-send id msg)
-           ;; FIXME: Guard against errors like in :emacs-rex?
            (slime-send `(:emacs-channel-send ,id ,msg)))
           ((:read-from-minibuffer thread tag prompt initial-value)
            (slime-read-from-minibuffer-for-swank thread tag prompt initial-value))
@@ -2492,8 +2485,6 @@
   (interactive)
   (setf (slime-rex-continuations) '())
   (mapc #'kill-buffer (sldb-buffers))
-  ;; Due to character encoding errors, a half-processed RPC result may
-  ;; get stuck in the connection buffer and keep Slime choking.
   (slime-with-connection-buffer ()
     (erase-buffer)))
 
@@ -2614,6 +2605,7 @@
     (pp event buffer)))
 
 (defun slime-events-buffer ()
+  "Return or create the event log buffer."
   (or (get-buffer slime-event-buffer-name)
       (let ((buffer (get-buffer-create slime-event-buffer-name)))
         (with-current-buffer buffer
@@ -2625,11 +2617,11 @@
             (outline-minor-mode)))
         buffer)))
 
-
 
 ;;;;; Cleanup after a quit
 
 (defun slime-restart-inferior-lisp ()
+  "Kill and restart the Lisp subprocess."
   (interactive)
   (assert (slime-inferior-process) () "No inferior lisp process")
   (slime-quit-lisp-internal (slime-connection) 'slime-restart-sentinel t))
@@ -2646,22 +2638,14 @@
                                      (plist-get args :program-args)
                                      (plist-get args :env)
                                      nil
-                                     buffer))
-         ;;(repl-buffer (slime-repl-buffer nil process))
-         ;;(repl-window (and repl-buffer (get-buffer-window repl-buffer)))
-         )
+                                     buffer)))
     (slime-net-close process)
     (slime-inferior-connect new-proc args)
-    (cond ;;((and repl-window (not buffer-window))
-          ;; (set-window-buffer repl-window buffer)
-          ;; (select-window repl-window))
-          ;;(repl-window
-          ;; (select-window repl-window))
-          (t 
-           (pop-to-buffer buffer)))
+    (pop-to-buffer buffer)
     (switch-to-buffer buffer)
     (goto-char (point-max))))
 
+;; FIXME: move to slime-repl
 (defun slime-kill-all-buffers ()
   "Kill all the slime related buffers.
 This is only used by the repl command sayoonara."
@@ -2684,6 +2668,7 @@
 The function receive two arguments: the beginning and the end of the 
 region that will be compiled.")
 
+;; FIXME: remove some of the options
 (defcustom slime-compilation-finished-hook 'slime-maybe-show-compilation-log
   "Hook called with a list of compiler notes after a compilation."
   :group 'slime-mode
@@ -2696,6 +2681,8 @@
              slime-maybe-show-xrefs-for-notes
              slime-goto-first-note))
 
+;; FIXME: I doubt that anybody uses this directly and it seems to be
+;; only an ugly way to pass arguments.
 (defvar slime-compilation-policy nil
   "When non-nil compile defuns with this debug optimization level.")
 
@@ -2744,8 +2731,6 @@
 
 See `slime-compile-and-load-file' for further details."
   (interactive)
-  ;;(unless (memq major-mode slime-lisp-modes)
-  ;;  (error "Only valid in lisp-mode"))
   (check-parens)
   (unless buffer-file-name
     (error "Buffer %s is not associated with a file." (buffer-name)))
@@ -2778,6 +2763,7 @@
   (slime-compile-string (buffer-substring-no-properties start end) start))
 
 (defun slime-flash-region (start end &optional timeout)
+  "Temporarily highlight region from START to END."
   (let ((overlay (make-overlay start end))) 
     (overlay-put overlay 'face 'secondary-selection)
     (run-with-timer (or timeout 0.2) nil 'delete-overlay overlay)))
@@ -2845,6 +2831,9 @@
 
 ;;;;; Recompilation.
 
+;; FIXME: This whole idea is questionable since it depends so
+;; crucially on precise source-locs.
+
 (defun slime-recompile-location (location)
   (save-excursion
     (slime-goto-source-location location)
@@ -2954,6 +2943,7 @@
           (display-buffer (current-buffer)))))))
 
 (defun slime-show-compilation-log (notes)
+  "Create and display the compilation log buffer."
   (interactive (list (slime-compiler-notes)))
   (slime-with-popup-buffer ("*SLIME Compilation*")
     (slime-insert-compilation-log notes)))
@@ -2999,8 +2989,8 @@
     (slime-indent-rigidly start (point) column)))
 
 (defun slime-canonicalized-location (location)
-  "Takes a `slime-location' and returns a list consisting of
-file/buffer name, line, and column number."
+  "Return a list (FILE LINE COLUMN) for slime-location LOCATION.
+This is quite an expensive operation so use carefully."
   (save-excursion
     (slime-goto-location-buffer (slime-location.buffer location))
     (save-excursion
@@ -3106,7 +3096,7 @@
   "Create an overlay representing a compiler note.
 The overlay has several properties:
   FACE       - to underline the relevant text.
-  SEVERITY   - for future reference, :NOTE, :STYLE-WARNING, :WARNING, or :ERROR.
+  SEVERITY   - for future reference :NOTE, :STYLE-WARNING, :WARNING, or :ERROR.
   MOUSE-FACE - highlight the note when the mouse passes over.
   HELP-ECHO  - a string describing the note, both for future reference
                and for display as a tooltip (due to the special
@@ -3273,6 +3263,10 @@
           (beginning-of-sexp))
       (error (goto-char origin)))))
 
+
+;; FIXME: really fix this mess
+;; FIXME: the check shouln't be done here anyway but by M-. itself.
+
 (defun slime-filesystem-toplevel-directory ()
   ;; Windows doesn't have a true toplevel root directory, and all
   ;; filenames look like "c:/foo/bar/quux.baz" from an Emacs

[518 lines skipped]




From heller at common-lisp.net  Wed Oct 28 10:15:20 2009
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 28 Oct 2009 06:15:20 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N35Ym-0000hf-MY@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-format-display-message, slime-display-message)
(slime-create-message-window): Deleted.  The trick with the
pre-command-hook doesn't work in XEmacs 21.5.  So use the standard
message function.  One day XEmacs will learn how to resize the
minibuffer, but until then we have to live with one-line messages.

--- /project/slime/cvsroot/slime/ChangeLog	2009/10/27 12:46:32	1.1890
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/28 10:15:20	1.1891
@@ -1,3 +1,11 @@
+2009-10-28  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-format-display-message, slime-display-message)
+	(slime-create-message-window): Deleted.  The trick with the
+	pre-command-hook doesn't work in XEmacs 21.5.  So use the standard
+	message function.  One day XEmacs will learn how to resize the
+	minibuffer, but until then we have to live with one-line messages.
+
 2009-10-27  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el: Fix some docstrings and comments.
--- /project/slime/cvsroot/slime/slime.el	2009/10/27 12:46:32	1.1237
+++ /project/slime/cvsroot/slime/slime.el	2009/10/28 10:15:20	1.1238
@@ -778,44 +778,6 @@
 (defun slime-display-warning (message &rest args)
   (display-warning '(slime warning) (apply #'format message args)))
 
-(when (or (featurep 'xemacs))
-  (setq slime-message-function 'slime-format-display-message))
-
-(defun slime-format-display-message (format &rest args)
-  (slime-display-message (apply #'format format args) "*SLIME Note*"))
-
-(defun slime-display-message (message buffer-name) 
-  "Display MESSAGE in the echo area or in BUFFER-NAME.
-Use the echo area if MESSAGE needs only a single line.  If the MESSAGE
-requires more than one line display it in BUFFER-NAME and add a hook
-to `slime-pre-command-actions' to remove the window before the next
-command."
-  (when (get-buffer-window buffer-name) (delete-windows-on buffer-name))
-  (cond ((or (string-match "\n" message)
-             (> (length message) (1- (frame-width))))
-         (lexical-let ((buffer (get-buffer-create buffer-name)))
-           (with-current-buffer buffer
-             (erase-buffer)
-             (insert message)
-             (goto-char (point-min))
-             (let ((win (slime-create-message-window)))
-               (set-window-buffer win (current-buffer))
-               (shrink-window-if-larger-than-buffer
-                (display-buffer (current-buffer)))))
-           (push (lambda () (delete-windows-on buffer) (bury-buffer buffer))
-                 slime-pre-command-actions)))
-        (t (message "%s" message))))
-
-(defun slime-create-message-window ()
-  "Create a window at the bottom of the frame, above the minibuffer."
-  (let ((previous (previous-window (minibuffer-window))))
-    (when (<= (window-height previous) (* 2 window-min-height))
-      (save-selected-window 
-        (select-window previous)
-        (enlarge-window (- (1+ (* 2 window-min-height))
-                           (window-height previous)))))
-    (split-window previous)))
-
 (defvar slime-background-message-function 'slime-display-oneliner)
 
 ;; Interface
@@ -8904,10 +8866,11 @@
 (slime-DEFUN-if-undefined set-process-coding-system 
     (process &optional decoding encoding))
 
-(slime-DEFUN-if-undefined display-warning  
-                          (type message &optional level buffer-name)
-  (slime-display-message (apply #'format (concat "Warning (%s): " message) type args)
-                         "*Warnings*"))
+;; For Emacs 21
+(slime-DEFUN-if-undefined display-warning 
+    (type message &optional level buffer-name)
+  (with-output-to-temp-buffer "*Warnings*"
+    (princ (apply #'format (concat "Warning (%s): " message) type args))))
 
 (unless (boundp 'temporary-file-directory)
   (defvar temporary-file-directory




From heller at common-lisp.net  Wed Oct 28 20:28:04 2009
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 28 Oct 2009 16:28:04 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N3F7k-00073r-1b@common-lisp.net>

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

Modified Files:
	ChangeLog swank-loader.lisp test.sh 
Log Message:
* test.sh: Don't copy contribs. Slime should work without them.
* swank-loader.lisp (setup): Compile contribs only if directory
exists.

--- /project/slime/cvsroot/slime/ChangeLog	2009/10/28 10:15:20	1.1891
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/28 20:28:03	1.1892
@@ -1,5 +1,11 @@
 2009-10-28  Helmut Eller  <heller at common-lisp.net>
 
+	* test.sh: Don't copy contribs. Slime should work without them.
+	* swank-loader.lisp (setup): Compile contribs only if directory
+	exists.
+
+2009-10-28  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el (slime-format-display-message, slime-display-message)
 	(slime-create-message-window): Deleted.  The trick with the
 	pre-command-hook doesn't work in XEmacs 21.5.  So use the standard
--- /project/slime/cvsroot/slime/swank-loader.lisp	2009/09/08 05:59:20	1.92
+++ /project/slime/cvsroot/slime/swank-loader.lisp	2009/10/28 20:28:03	1.93
@@ -226,7 +226,8 @@
 (defun setup ()
   (load-site-init-file *source-directory*)
   (load-user-init-file)
-  (eval `(pushnew 'compile-contribs ,(q "swank::*after-init-hook*")))
+  (when (probe-file (contrib-dir *source-directory*))
+    (eval `(pushnew 'compile-contribs ,(q "swank::*after-init-hook*"))))
   (funcall (q "swank::init")))
 
 (defun init (&key delete reload load-contribs (setup t))
--- /project/slime/cvsroot/slime/test.sh	2009/10/26 19:17:00	1.22
+++ /project/slime/cvsroot/slime/test.sh	2009/10/28 20:28:03	1.23
@@ -69,7 +69,8 @@
 
 mkdir $tmpdir
 if [ $use_temp_dir == true ] ; then 
-    cp -r $slimedir/*.{el,lisp} ChangeLog $slimedir/contrib $tmpdir
+    cp -r $slimedir/*.{el,lisp} ChangeLog $tmpdir 
+    # cp -r $slimedir/contrib $tmpdir 
 fi
 
 cmd=($emacs -nw -q -no-site-file $batch_mode --no-site-file




From heller at common-lisp.net  Wed Oct 28 20:28:14 2009
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 28 Oct 2009 16:28:14 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N3F7u-00074g-MY@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-disconnect): Don't reference connection.  Left
over from last change.
([test] arglist): Update expected results for slightly changed
printer settings.
([test] indentation): Install common-lisp-indent-function.

* test.sh: Don't copy contribs. Slime should work without them.
* swank-loader.lisp (setup): Compile contribs only if directory
exists.

--- /project/slime/cvsroot/slime/ChangeLog	2009/10/28 20:28:03	1.1892
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/28 20:28:14	1.1893
@@ -1,5 +1,11 @@
 2009-10-28  Helmut Eller  <heller at common-lisp.net>
 
+	* slime.el (slime-disconnect): Don't reference connection.  Left
+	over from last change.
+	([test] arglist): Update expected results for slightly changed
+	printer settings.
+	([test] indentation): Install common-lisp-indent-function.
+
 	* test.sh: Don't copy contribs. Slime should work without them.
 	* swank-loader.lisp (setup): Compile contribs only if directory
 	exists.
--- /project/slime/cvsroot/slime/slime.el	2009/10/28 10:15:20	1.1238
+++ /project/slime/cvsroot/slime/slime.el	2009/10/28 20:28:14	1.1239
@@ -2076,7 +2076,7 @@
 (defun slime-disconnect ()
   "Close the current connection."
   (interactive)
-  (slime-net-close (or connection (slime-connection))))
+  (slime-net-close (slime-connection)))
 
 (defun slime-disconnect-all ()
   "Disconnect all connections."
@@ -7710,12 +7710,12 @@
 Confirm that EXPECTED-ARGLIST is displayed."
     '(("swank::operator-arglist" "(swank::operator-arglist name package)")
       ("swank::create-socket" "(swank::create-socket host port)")
-      ("swank::emacs-connected" "(swank::emacs-connected )")
+      ("swank::emacs-connected" "(swank::emacs-connected)")
       ("swank::compile-string-for-emacs"
        "(swank::compile-string-for-emacs string buffer position filename policy)")
       ("swank::connection.socket-io"
        "(swank::connection.socket-io \\(struct\\(ure\\)?\\|object\\|instance\\|x\\))")
-      ("cl:lisp-implementation-type" "(cl:lisp-implementation-type )")
+      ("cl:lisp-implementation-type" "(cl:lisp-implementation-type)")
       ("cl:class-name" 
        "(cl:class-name \\(class\\|object\\|instance\\|structure\\))"))
   (let ((arglist (slime-eval `(swank:operator-arglist ,function-name 
@@ -8031,7 +8031,7 @@
        ("23" "42")))
   (with-temp-buffer
     (lisp-mode)
-    (slime-mode 1)
+    (slime-lisp-mode-hook)
     (insert buffer-content)
     (slime-compile-region (point-min) (point-max))
     (slime-sync-to-top-level 3)




From heller at common-lisp.net  Wed Oct 28 20:28:25 2009
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 28 Oct 2009 16:28:25 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N3F85-00075L-IK@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el ([undefun] display-warning): Fix it.

--- /project/slime/cvsroot/slime/ChangeLog	2009/10/28 20:28:14	1.1893
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/28 20:28:25	1.1894
@@ -5,6 +5,7 @@
 	([test] arglist): Update expected results for slightly changed
 	printer settings.
 	([test] indentation): Install common-lisp-indent-function.
+	([undefun] display-warning): Fix it.
 
 	* test.sh: Don't copy contribs. Slime should work without them.
 	* swank-loader.lisp (setup): Compile contribs only if directory
--- /project/slime/cvsroot/slime/slime.el	2009/10/28 20:28:14	1.1239
+++ /project/slime/cvsroot/slime/slime.el	2009/10/28 20:28:25	1.1240
@@ -74,7 +74,8 @@
   (require 'arc-mode)
   (require 'apropos)
   (require 'outline)
-  (require 'etags))
+  (require 'etags)
+  (require 'compile))
 
 (eval-and-compile 
   (defvar slime-path
@@ -8867,10 +8868,10 @@
     (process &optional decoding encoding))
 
 ;; For Emacs 21
-(slime-DEFUN-if-undefined display-warning 
+(slime-DEFUN-if-undefined display-warning
     (type message &optional level buffer-name)
   (with-output-to-temp-buffer "*Warnings*"
-    (princ (apply #'format (concat "Warning (%s): " message) type args))))
+    (princ (format "Warning (%s %s): %s" type level message))))
 
 (unless (boundp 'temporary-file-directory)
   (defvar temporary-file-directory




From heller at common-lisp.net  Wed Oct 28 20:28:34 2009
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 28 Oct 2009 16:28:34 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N3F8E-00075y-C0@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Simpler modeline code.

* slime.el (slime-modeline-string): Renamed from
slime-compute-modeline-string.
(slime-modeline-state-string): Renamed from
slime-compute-connection-state
(slime-modeline-package, slime-modeline-connection-name)
(slime-modeline-connection-state)
(slime-extended-modeline,slime-compute-modeline-package)
(slime-update-modeline-string, slime-shall-we-update-modeline-p
(slime-update-all-modelines, slime-modeline-update-timer)
(slime-restart-or-init-modeline-update-timer)
(slime-connection-state-as-string): Deleted.

--- /project/slime/cvsroot/slime/ChangeLog	2009/10/28 20:28:25	1.1894
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/28 20:28:34	1.1895
@@ -1,5 +1,21 @@
 2009-10-28  Helmut Eller  <heller at common-lisp.net>
 
+	Simpler modeline code.
+
+	* slime.el (slime-modeline-string): Renamed from
+	slime-compute-modeline-string.
+	(slime-modeline-state-string): Renamed from
+	slime-compute-connection-state
+	(slime-modeline-package, slime-modeline-connection-name)
+	(slime-modeline-connection-state)
+	(slime-extended-modeline,slime-compute-modeline-package)
+	(slime-update-modeline-string, slime-shall-we-update-modeline-p
+	(slime-update-all-modelines, slime-modeline-update-timer)
+	(slime-restart-or-init-modeline-update-timer)
+	(slime-connection-state-as-string): Deleted.
+
+2009-10-28  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el (slime-disconnect): Don't reference connection.  Left
 	over from last change.
 	([test] arglist): Update expected results for slightly changed
--- /project/slime/cvsroot/slime/slime.el	2009/10/28 20:28:25	1.1240
+++ /project/slime/cvsroot/slime/slime.el	2009/10/28 20:28:34	1.1241
@@ -156,13 +156,6 @@
   :type 'boolean
   :group 'slime-ui)
 
-(defcustom slime-extended-modeline t
-  "If non-nil, display various information in the mode line of a
-Lisp buffer. The information includes the current connection of
-that buffer, the buffer package, and some state indication."
-  :type 'boolean
-  :group 'slime-ui)
-
 (defcustom slime-kill-without-query-p nil
   "If non-nil, kill SLIME processes without query when quitting Emacs.
 This applies to the *inferior-lisp* buffer and the network connections."
@@ -417,31 +410,39 @@
   nil
   ;; Fake binding to coax `define-minor-mode' to create the keymap
   '((" " 'undefined))
-  (slime-setup-command-hooks))
-
-(make-variable-buffer-local
- (defvar slime-modeline-string nil
-   "The string that should be displayed in the modeline if
-`slime-extended-modeline' is true, and which indicates the
-current connection, package and state of a Lisp buffer.
-The string is periodically updated by an idle timer."))
+  (slime-setup-command-hooks)
+  (slime-recompute-modelines))
 
+
+;;;;;; Modeline
 
-;;; These are used to keep track of old values, so we can determine
-;;; whether the mode line has changed, and should be updated.
-(make-variable-buffer-local
- (defvar slime-modeline-package nil))
-(make-variable-buffer-local
- (defvar slime-modeline-connection-name nil))
+;; For XEmacs only
 (make-variable-buffer-local
- (defvar slime-modeline-connection-state nil))
+ (defvar slime-modeline-string nil
+   "The string that should be displayed in the modeline."))
 
-(defun slime-compute-modeline-package ()
-  (when (memq major-mode slime-lisp-modes)
-    ;; WHEN-LET is defined later.
-    (let ((package (slime-current-package)))
-      (when package
-        (slime-pretty-package-name package)))))
+(add-to-list 'minor-mode-alist
+             `(slime-mode ,(if (featurep 'xemacs)
+                               'slime-modeline-string
+                             '(:eval (slime-modeline-string)))))
+
+(defun slime-modeline-string ()
+  "Return the string to display in the modeline.
+\"Slime\" only appears if we aren't connected.  If connected,
+include package-name, connection-name, and possibly some state
+information."
+  (let* ((conn (slime-current-connection))
+         (local (and conn (eq conn slime-buffer-connection)))
+         (pkg (slime-current-package)))
+    (cond ((not conn) (and slime-mode " Slime"))
+          ((concat " "
+                   (if local "{" "[")
+                   (if pkg (slime-pretty-package-name pkg) "?")
+                   " "
+                   ;; ignore errors for closed connections
+                   (ignore-errors (slime-connection-name conn))
+                   (slime-modeline-state-string conn)
+                   (if local "}" "]"))))))
 
 (defun slime-pretty-package-name (name)
   "Return a pretty version of a package name NAME."
@@ -451,92 +452,23 @@
          (match-string 1 name))
         (t name)))
 
-(defun slime-compute-modeline-connection ()
-  (let ((conn (slime-current-connection)))
-    (if (or (null conn) (slime-stale-connection-p conn)) 
-        nil
-        (slime-connection-name conn))))
-
-(defun slime-compute-modeline-connection-state ()
-  (let* ((conn (slime-current-connection))
-         (new-state (slime-compute-connection-state conn)))
-    (if (eq new-state :connected)
-        (let ((rex-cs  (length (slime-rex-continuations)))
-              (sldb-cs (length (sldb-debugged-continuations conn)))
-              ;; There can be SLDB buffers which have no continuations
-              ;; attached to it, e.g. the one resulting from
-              ;; `slime-interrupt'.
-              (sldbs   (length (sldb-buffers conn))))
-          (cond ((and (= sldbs 0) (zerop rex-cs)) nil)
-                ((= sldbs 0) (format "%s" rex-cs))
-                (t (format "%s/%s"
-                           (if (= rex-cs 0) 0 (- rex-cs sldb-cs)) 
-                           sldbs))))
-      (slime-connection-state-as-string new-state))))
-
-(defun slime-compute-modeline-string (conn state pkg)
-  (concat (when (or conn pkg)             "[")
-          (when pkg                       (format "%s" pkg))
-          (when (and (or conn state) pkg) ", ")
-          (when conn                      (format "%s" conn))
-          (when state                     (format "{%s}" state))
-          (when (or conn pkg)             "]")))
-
-(defun slime-update-modeline-string ()
-  (let ((old-pkg   slime-modeline-package)
-        (old-conn  slime-modeline-connection-name)
-        (old-state slime-modeline-connection-state)
-        (new-pkg   (slime-compute-modeline-package))
-        (new-conn  (slime-compute-modeline-connection))
-        (new-state (slime-compute-modeline-connection-state)))
-    (when (or (not (equal old-pkg   new-pkg))
-              (not (equal old-conn  new-conn))
-              (not (equal old-state new-state)))
-      (setq slime-modeline-package new-pkg)
-      (setq slime-modeline-connection-name new-conn)
-      (setq slime-modeline-connection-state new-state)
-      (setq slime-modeline-string
-            (slime-compute-modeline-string new-conn new-state new-pkg)))))
-
-(defun slime-shall-we-update-modeline-p ()
-  (and slime-extended-modeline 
-       (or slime-mode slime-popup-buffer-mode)))
-
-(defun slime-update-all-modelines ()
-  (dolist (window (window-list))
-    (with-current-buffer (window-buffer window)
-      (when (slime-shall-we-update-modeline-p)
-        (slime-update-modeline-string)
-        (force-mode-line-update)))))
-
-(defvar slime-modeline-update-timer nil)
-
-(defun slime-restart-or-init-modeline-update-timer ()
-  (when slime-modeline-update-timer
-    (cancel-timer slime-modeline-update-timer))
-  (setq slime-modeline-update-timer
-        (run-with-idle-timer 0.1 nil 'slime-update-all-modelines)))
-
-(slime-restart-or-init-modeline-update-timer)
-
-(defun slime-recompute-modelines (delay)
-  (cond (delay
-         ;; Minimize flashing of modeline due to short lived
-         ;; requests such as those of autodoc.
-         (slime-restart-or-init-modeline-update-timer))
-        (t
-         ;; Must do this ourselves since emacs may have
-         ;; been idling long enough that
-         ;; SLIME-MODELINE-UPDATE-TIMER is not going to
-         ;; trigger by itself.
-         (slime-update-all-modelines))))
-
-;; Setup the mode-line to say when we're in slime-mode, which
-;; connection is active, and which CL package we think the current
-;; buffer belongs to.
-(add-to-list 'minor-mode-alist
-             '(slime-mode
-               (" Slime" slime-modeline-string)))
+(defun slime-modeline-state-string (conn)
+  "Return a string possibly describing CONN's state."
+  (cond ((not (eq (process-status conn) 'open))
+         (format " %s" (process-status conn)))
+        ((let ((pending (length (slime-rex-continuations conn)))
+               (sldbs (length (sldb-buffers conn))))
+           (cond ((and (zerop sldbs) (zerop pending)) nil)
+                 ((zerop sldbs) (format " %s" pending))
+                 (t (format " %s/%s" pending sldbs)))))))
+
+(defun slime-recompute-modelines ()
+  (when (featurep 'xemacs)
+    (dolist (buffer (buffer-list))
+      (with-current-buffer buffer
+        (when (or slime-mode slime-popup-buffer-mode)
+          (setq slime-modeline-string (slime-modeline-string)))))
+    (force-mode-line-update t)))
 
 
 ;;;;; Key bindings
@@ -1099,11 +1031,17 @@
 (define-minor-mode slime-popup-buffer-mode 
   "Mode for displaying read only stuff"
   nil
-  (" Slime-Tmp" slime-modeline-string)
+  nil
   '(("q" . slime-popup-buffer-quit-function)
     ;;("\C-c\C-z" . slime-switch-to-output-buffer)
     ("\M-." . slime-edit-definition)))
 
+(add-to-list 'minor-mode-alist
+             `(slime-popup-buffer-mode
+               ,(if (featurep 'xemacs)
+                    'slime-modeline-string
+                  '(:eval (slime-modeline-string)))))
+
 (set-keymap-parent slime-popup-buffer-mode-map slime-parent-map)
 
 (make-variable-buffer-local
@@ -1907,21 +1845,6 @@
 
 (put 'slime-with-connection-buffer 'lisp-indent-function 1)
 
-(defun slime-compute-connection-state (conn)
-  (cond ((null conn) :disconnected) 
-        ((slime-stale-connection-p conn) :stale)
-        ((and (slime-use-sigint-for-interrupt conn)
-              (slime-busy-p conn)) :busy)
-        ((eq slime-buffer-connection conn) :local)
-        (t :connected)))
-
-(defun slime-connection-state-as-string (state)
-  (case state
-    (:disconnected    "not connected")
-    (:busy            "busy..")
-    (:stale           "stale")
-    (:local           "local")))
-
 ;;; Connection-local variables:
 
 (defmacro slime-def-connection-var (varname &rest initial-value-and-doc)
@@ -2369,12 +2292,12 @@
            (let ((id (incf (slime-continuation-counter))))
              (slime-send `(:emacs-rex ,form ,package ,thread ,id))
              (push (cons id continuation) (slime-rex-continuations))
-             (slime-recompute-modelines t)))
+             (slime-recompute-modelines)))
           ((:return value id)
            (let ((rec (assq id (slime-rex-continuations))))
              (cond (rec (setf (slime-rex-continuations)
                               (remove rec (slime-rex-continuations)))
-                        (slime-recompute-modelines nil)
+                        (slime-recompute-modelines)
                         (funcall (cdr rec) value))
                    (t
                     (error "Unexpected reply: %S %S" id value)))))




From heller at common-lisp.net  Wed Oct 28 20:52:20 2009
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 28 Oct 2009 16:52:20 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N3FVE-0000Zo-KS@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-stale-connection-p): Deleted.

--- /project/slime/cvsroot/slime/ChangeLog	2009/10/28 20:28:34	1.1895
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/28 20:52:20	1.1896
@@ -9,10 +9,11 @@
 	(slime-modeline-package, slime-modeline-connection-name)
 	(slime-modeline-connection-state)
 	(slime-extended-modeline,slime-compute-modeline-package)
-	(slime-update-modeline-string, slime-shall-we-update-modeline-p
+	(slime-update-modeline-string, slime-shall-we-update-modeline-p)
 	(slime-update-all-modelines, slime-modeline-update-timer)
 	(slime-restart-or-init-modeline-update-timer)
-	(slime-connection-state-as-string): Deleted.
+	(slime-connection-state-as-string): Deleted
+	(slime-stale-connection-p): Deleted.
 
 2009-10-28  Helmut Eller  <heller at common-lisp.net>
 
--- /project/slime/cvsroot/slime/slime.el	2009/10/28 20:28:34	1.1241
+++ /project/slime/cvsroot/slime/slime.el	2009/10/28 20:52:20	1.1242
@@ -2230,9 +2230,6 @@
     (error "Not connected. Use `%s' to start a Lisp."
            (substitute-command-keys "\\[slime]"))))
 
-(defun slime-stale-connection-p (conn)
-  (not (memq conn slime-net-processes)))
-
 ;; UNUSED
 (defun slime-debugged-connection-p (conn)
   ;; This previously was (AND (SLDB-DEBUGGED-CONTINUATIONS CONN) T),




From heller at common-lisp.net  Fri Oct 30 10:57:55 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 30 Oct 2009 06:57:55 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N3pB5-0008EP-Ix@common-lisp.net>

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

Modified Files:
	ChangeLog swank-ccl.lisp 
Removed Files:
	swank-openmcl.lisp test-all.sh 
Log Message:
* swank-openmcl.lisp: Removed. 1.4 is out so no longer needed.
* swank-ccl.lisp: Update accordingly.

* test-all.sh: Removed. Not used in ages.


--- /project/slime/cvsroot/slime/ChangeLog	2009/10/28 20:52:20	1.1896
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/30 10:57:55	1.1897
@@ -1,3 +1,10 @@
+2009-10-30  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-openmcl.lisp: Removed. 1.4 is out so no longer needed.
+	* swank-ccl.lisp: Update accordingly.
+
+	* test-all.sh: Removed. Not used in ages.
+
 2009-10-28  Helmut Eller  <heller at common-lisp.net>
 
 	Simpler modeline code.
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2009/10/24 11:32:18	1.8
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2009/10/30 10:57:55	1.9
@@ -52,14 +52,6 @@
 
 (in-package :swank-backend)
 
-;; Backward compatibility
-(eval-when (:compile-toplevel)
-  (unless (fboundp 'ccl:compute-applicable-methods-using-classes)
-    (compile-file (make-pathname :name "swank-openmcl" :type "lisp" :defaults swank-loader::*source-directory*)
-                  :output-file (make-pathname :name "swank-ccl" :defaults swank-loader::*fasl-directory*)
-                  :verbose t)
-    (invoke-restart (find-restart 'ccl::skip-compile-file))))
-
 (eval-when (:compile-toplevel :execute :load-toplevel)
   (assert (and (= ccl::*openmcl-major-version* 1)
                (>= ccl::*openmcl-minor-version* 4))




From sboukarev at common-lisp.net  Fri Oct 30 19:39:34 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 30 Oct 2009 15:39:34 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N3xJu-00025E-Pd@common-lisp.net>

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

Modified Files:
	ChangeLog swank-loader.lisp 
Log Message:
* swank-loader.lisp (setup): Use EXT:PROBE-DIRECTORY on Clisp,
because PROBE-FILE doesn't want to work on directories.
Patch by Dirk Sondermann.


--- /project/slime/cvsroot/slime/ChangeLog	2009/10/30 10:57:55	1.1897
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/30 19:39:34	1.1898
@@ -1,3 +1,9 @@
+2009-10-30  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-loader.lisp (setup): Use EXT:PROBE-DIRECTORY on Clisp,
+	because PROBE-FILE doesn't want to work on directories.
+	Patch by Dirk Sondermann.
+
 2009-10-30  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-openmcl.lisp: Removed. 1.4 is out so no longer needed.
--- /project/slime/cvsroot/slime/swank-loader.lisp	2009/10/28 20:28:03	1.93
+++ /project/slime/cvsroot/slime/swank-loader.lisp	2009/10/30 19:39:34	1.94
@@ -226,7 +226,9 @@
 (defun setup ()
   (load-site-init-file *source-directory*)
   (load-user-init-file)
-  (when (probe-file (contrib-dir *source-directory*))
+  (when (#-clisp probe-file
+         #+clisp ext:probe-directory        
+         (contrib-dir *source-directory*))
     (eval `(pushnew 'compile-contribs ,(q "swank::*after-init-hook*"))))
   (funcall (q "swank::init")))
 




From trittweiler at common-lisp.net  Fri Oct 30 23:06:27 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 30 Oct 2009 19:06:27 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N40Y7-0001ce-86@common-lisp.net>

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

Modified Files:
	slime-sbcl-exts.el ChangeLog 
Log Message:
	`M-x slime-visit-sbcl-bug' will open a browser to visit SBCL's bug
	tracker at Launchpad that describes the bug number at
	point (#nnnnnn).

	* slime-sbcl-exts.el (slime-visit-sbcl-bug): New.
	(slime-read-sbcl-bug): New.
	(slime-sbcl-bug-at-point): New.


--- /project/slime/cvsroot/slime/contrib/slime-sbcl-exts.el	2008/12/31 12:31:32	1.2
+++ /project/slime/cvsroot/slime/contrib/slime-sbcl-exts.el	2009/10/30 23:06:26	1.3
@@ -8,6 +8,29 @@
 (require 'slime-autodoc)
 (require 'slime-references)
 
+(defun slime-sbcl-bug-at-point ()
+  (save-excursion
+    (save-match-data
+      (unless (looking-at "#[0-9]\\{6\\}")
+        (search-backward-regexp "#\\<" (line-beginning-position) t))
+      (when (looking-at "#[0-9]\\{6\\}")
+        (buffer-substring-no-properties (match-beginning 0) (match-end 0))))))
+
+(defun slime-read-sbcl-bug (prompt &optional query)
+  "Either read a sbcl bug or choose the one at point.
+The user is prompted if a prefix argument is in effect, if there is no
+symbol at point, or if QUERY is non-nil."
+  (let ((bug (slime-sbcl-bug-at-point)))
+    (cond ((or current-prefix-arg query (not bug))
+           (slime-read-from-minibuffer prompt bug))
+          (t bug))))
+
+(defun slime-visit-sbcl-bug (bug)
+  "Visit the Launchpad site that describes `bug' (#nnnnnn)."
+  (interactive (list (slime-read-sbcl-bug "Bug number (#nnnnnn): ")))
+  (browse-url (format "http://bugs.launchpad.net/sbcl/+bug/%s" 
+                      (substring bug 1))))
+
 (defun slime-enable-autodoc-for-sb-assem:inst ()
   (push '("INST" . (slime-make-extended-operator-parser/look-ahead 1))
         slime-extended-operator-name-parser-alist))
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/21 19:38:49	1.261
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/30 23:06:26	1.262
@@ -1,3 +1,13 @@
+2009-10-31  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	`M-x slime-visit-sbcl-bug' will open a browser to visit SBCL's bug
+	tracker at Launchpad that describes the bug number at
+	point (#nnnnnn).
+
+	* slime-sbcl-exts.el (slime-visit-sbcl-bug): New.
+	(slime-read-sbcl-bug): New.
+	(slime-sbcl-bug-at-point): New.
+
 2009-10-21  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-asdf.el (slime-browse-system): Open the parent directory of




From heller at common-lisp.net  Sat Oct 31 08:22:56 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 31 Oct 2009 04:22:56 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N49Ee-0006WK-QM@common-lisp.net>

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

Modified Files:
	ChangeLog swank-backend.lisp swank-ccl.lisp 
Log Message:
* swank-ccl.lisp (kill-thread): Don't signal conditions.
* swank-backend.lisp (kill-thread): Update docstring.

--- /project/slime/cvsroot/slime/ChangeLog	2009/10/30 19:39:34	1.1898
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/31 08:22:56	1.1899
@@ -1,3 +1,8 @@
+2009-10-31  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-ccl.lisp (kill-thread): Don't signal conditions.
+	* swank-backend.lisp (kill-thread): Update docstring.
+
 2009-10-30  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-loader.lisp (setup): Use EXT:PROBE-DIRECTORY on Clisp,
--- /project/slime/cvsroot/slime/swank-backend.lisp	2009/09/20 09:39:16	1.181
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2009/10/31 08:22:56	1.182
@@ -1057,7 +1057,9 @@
   "Cause THREAD to execute FN.")
 
 (definterface kill-thread (thread)
-  "Kill THREAD."
+  "Terminate THREAD immediately.
+Don't execute unwind-protected sections, don't raise conditions.
+(Do not pass go, do not collect $200.)"
   (declare (ignore thread))
   nil)
 
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2009/10/30 10:57:55	1.9
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2009/10/31 08:22:56	1.10
@@ -720,10 +720,14 @@
   (queue '() :type list))
 
 (defimplementation spawn (fun &key name)
-  (ccl:process-run-function 
-   (or name "Anonymous (Swank)")
-   fun))
-
+  (flet ((entry ()
+           (handler-bind ((ccl:process-reset (lambda (c) 
+                                               (return-from entry c))))
+             (funcall fun))))
+    (ccl:process-run-function 
+     (or name "Anonymous (Swank)")
+     #'entry)))
+  
 (defimplementation thread-id (thread)
   (ccl:process-serial-number thread))
 
@@ -753,7 +757,8 @@
   (ccl:all-processes))
 
 (defimplementation kill-thread (thread)
-  (ccl:process-kill thread))
+  ;;(ccl:process-kill thread) ; doesn't cut it
+  (ccl::process-initial-form-exited thread :kill))
 
 (defimplementation thread-alive-p (thread)
   (not (ccl:process-exhausted-p thread)))




From heller at common-lisp.net  Sat Oct 31 08:54:46 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 31 Oct 2009 04:54:46 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N49jS-0007xc-5o@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank-abcl.lisp swank-backend.lisp 
	swank.lisp 
Log Message:
* swank.lisp (list-threads): Remove thread-description.  Wasn't
used anymore.
* swank-backend.lisp (thread-description, set-thread-description):
Deleted.
* swank-abcl.lisp: Update accordingly.
* slime.el (slime-update-threads-buffer, slime-thread-insert):
Update accordingly.

--- /project/slime/cvsroot/slime/ChangeLog	2009/10/31 08:22:56	1.1899
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/31 08:54:45	1.1900
@@ -1,5 +1,15 @@
 2009-10-31  Helmut Eller  <heller at common-lisp.net>
 
+	* swank.lisp (list-threads): Remove thread-description.  Wasn't
+	used anymore.
+	* swank-backend.lisp (thread-description, set-thread-description):
+	Deleted.
+	* swank-abcl.lisp: Update accordingly.
+	* slime.el (slime-update-threads-buffer, slime-thread-insert):
+	Update accordingly.
+
+2009-10-31  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-ccl.lisp (kill-thread): Don't signal conditions.
 	* swank-backend.lisp (kill-thread): Update docstring.
 
--- /project/slime/cvsroot/slime/slime.el	2009/10/28 20:52:20	1.1242
+++ /project/slime/cvsroot/slime/slime.el	2009/10/31 08:54:45	1.1243
@@ -6161,20 +6161,19 @@
       (let ((inhibit-read-only t))
         (erase-buffer)
         (loop for idx from 0 
-              for (id name status desc) in threads
-              do (slime-thread-insert idx name status desc id))
+              for (id name status) in threads
+              do (slime-thread-insert idx name status id))
         (goto-char (point-min))))))
 
-(defun slime-thread-insert (idx name status summary id)
+(defun slime-thread-insert (idx name status id)
   (slime-propertize-region `(thread-id ,idx)
     (insert (format "%3s: " id))
     (slime-insert-propertized '(face bold) name)
     (insert-char ?\  (- 30 (current-column)))
-    (let ((summary-start (point)))
+    (let ((start (point)))
       (insert " " status)
-      (insert " " summary)
       (unless (bolp) (insert "\n"))
-      (indent-rigidly summary-start (point) 2))))
+      (indent-rigidly start (point) 2))))
 
 
 ;;;;; Major mode
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/09/20 10:51:50	1.74
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/10/31 08:54:46	1.75
@@ -585,18 +585,6 @@
   (defimplementation thread-status (thread)
     (format nil "Thread is ~:[dead~;alive~]" (threads:thread-alive-p thread)))
 
-  ;; XXX should be a weak hash table
-  (defparameter *thread-description-map* (make-hash-table)) 
-
-  (defimplementation thread-description (thread) 
-    (threads:synchronized-on *thread-description-map*
-      (or (gethash thread *thread-description-map*)
-          "")))
-
-  (defimplementation set-thread-description (thread description) 
-    (threads:synchronized-on *thread-description-map*
-      (setf (gethash thread *thread-description-map*) description)))
-
   (defimplementation make-lock (&key name)
     (declare (ignore name))
     (threads:make-thread-lock))
--- /project/slime/cvsroot/slime/swank-backend.lisp	2009/10/31 08:22:56	1.182
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2009/10/31 08:54:46	1.183
@@ -1003,9 +1003,8 @@
 
 (definterface thread-name (thread)
    "Return the name of THREAD.
-
-Thread names are be single-line strings and are meaningful to the
-user. They do not have to be unique."
+Thread names are short strings meaningful to the user. They do not
+have to be unique."
    (declare (ignore thread))
    "The One True Thread")
 
@@ -1014,16 +1013,6 @@
    (declare (ignore thread))
    "")
 
-(definterface thread-description (thread)
-  "Return a string describing THREAD."
-  (declare (ignore thread))
-  "")
-
-(definterface set-thread-description (thread description)
-  "Set THREAD's description to DESCRIPTION."
-  (declare (ignore thread description))
-  "")
-
 (definterface thread-attributes (thread)
   "Return a plist of implementation-dependent attributes for THREAD"
   (declare (ignore thread))
--- /project/slime/cvsroot/slime/swank.lisp	2009/10/24 11:05:15	1.666
+++ /project/slime/cvsroot/slime/swank.lisp	2009/10/31 08:54:46	1.667
@@ -3623,21 +3623,20 @@
 a time.")
 
 (defslimefun list-threads ()
-  "Return a list (LABELS (ID NAME STATUS DESCRIPTION ATTRS ...) ...).
+  "Return a list (LABELS (ID NAME STATUS ATTRS ...) ...).
 LABELS is a list of attribute names and the remaining lists are the
 corresponding attribute values per thread."
   (setq *thread-list* (all-threads))
   (let* ((plist (thread-attributes (car *thread-list*)))
          (labels (loop for (key) on plist by #'cddr 
                        collect key)))
-    `((:id :name :status :description , at labels)
+    `((:id :name :status , at labels)
       ,@(loop for thread in *thread-list*
               for name = (thread-name thread)
               for attributes = (thread-attributes thread)
               collect (list* (thread-id thread)
-                             (if (symbolp name) (symbol-name name) name)
+                             (string name)
                              (thread-status thread)
-                             (thread-description thread)
                              (loop for label in labels
                                    collect (getf attributes label)))))))
 




From trittweiler at common-lisp.net  Sat Oct 31 19:38:29 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 31 Oct 2009 15:38:29 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N4JmP-0006rl-1V@common-lisp.net>

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

Modified Files:
	swank-arglists.lisp ChangeLog 
Log Message:
	* swank-arglists.lisp (extra-keywords :around): Sort keyword
	parameters such that implementation-internal stuff is shown last.
	(compose): New helper.
	(make-package-comparator): New.
	(sort-extra-keywords): New.


--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/09/02 17:21:16	1.34
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/10/31 19:38:28	1.35
@@ -12,6 +12,11 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (swank-require :swank-c-p-c))
 
+(defun compose (&rest functions)
+  "Compose FUNCTIONS right-associatively, returning a function"
+  #'(lambda (x)
+      (reduce #'funcall functions :initial-value x :from-end t)))
+
 (defun length= (seq n)
   "Test for whether SEQ contains N number of elements. I.e. it's equivalent
  to (= (LENGTH SEQ) N), but besides being more concise, it may also be more
@@ -147,8 +152,8 @@
                                       (format nil "[Declaration] ~A" stringified-arglist))))))
                            (t stringified-arglist))))))
               (mapc #'unintern-in-home-package newly-interned-symbols)))))
-    (error (cond)
-      (format nil "ARGLIST (error): ~A" cond))
+    (error (condition)
+      (format nil "ARGLIST (error): ~A" condition))
     ))
 
 (defun %find-declaration-operator (raw-specs position)
@@ -791,6 +796,50 @@
 As a tertiary value, return the initial sublist of ARGS that was needed 
 to determine the extra keywords."))
 
+;;; We make sure that symbol-from-KEYWORD-using keywords come before
+;;; symbol-from-arbitrary-package-using keywords. And we sort the
+;;; latter according to how their home-packages relate to *PACKAGE*.
+;;;
+;;; Rationale is to show those key parameters first which make most
+;;; sense in the current context. And in particular: to put
+;;; implementation-internal stuff last.
+;;;
+;;; This matters tremendeously on Allegro in combination with
+;;; AllegroCache as that does some evil tinkering with initargs,
+;;; obfuscating the arglist of MAKE-INSTANCE.
+;;;
+
+(defmethod extra-keywords :around (op &rest args)
+  (declare (ignorable op args))
+  (sort-extra-keywords (call-next-method)))
+
+(defun make-package-comparator (reference-packages)
+  "Returns a two-argument test function which compares packages
+according to their used-by relation with REFERENCE-PACKAGES. Packages
+will be sorted first which appear first in the PACKAGE-USE-LIST of the
+reference packages."
+  (let ((package-use-table (make-hash-table :test 'eq)))
+    ;; Walk the package dependency graph breadth-fist, and fill
+    ;; PACKAGE-USE-TABLE accordingly.
+    (loop with queue = (copy-list reference-packages)
+	  with bfn   = 0		; Breadth-First Number
+	  for p      = (pop queue) 
+	  unless (gethash p package-use-table)
+	    do      (setf (gethash p package-use-table) (shiftf bfn (1+ bfn)))
+	    and do  (setf queue (nconc queue (copy-list (package-use-list p))))
+	  while queue)
+    #'(lambda (p1 p2)
+	(let ((bfn1 (gethash p1 package-use-table))
+	      (bfn2 (gethash p2 package-use-table)))
+	  (cond ((and bfn1 bfn2) (<= bfn1 bfn2))
+		(bfn1            bfn1)
+		(bfn2            nil)	; p2 is used, p1 not
+		(t (string<= (package-name p1) (package-name p2))))))))
+
+(defun sort-extra-keywords (kwds)
+  (stable-sort kwds (make-package-comparator (list keyword-package *package*))
+               :key (compose #'symbol-package #'keyword-arg.keyword)))
+
 (defun keywords-of-operator (operator)
   "Return a list of KEYWORD-ARGs that OPERATOR accepts.
 This function is useful for writing EXTRA-KEYWORDS methods for
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/30 23:06:26	1.262
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/31 19:38:28	1.263
@@ -1,5 +1,13 @@
 2009-10-31  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* swank-arglists.lisp (extra-keywords :around): Sort keyword
+	parameters such that implementation-internal stuff is shown last.
+	(compose): New helper.
+	(make-package-comparator): New.
+	(sort-extra-keywords): New.
+
+2009-10-31  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	`M-x slime-visit-sbcl-bug' will open a browser to visit SBCL's bug
 	tracker at Launchpad that describes the bug number at
 	point (#nnnnnn).




From trittweiler at common-lisp.net  Sat Oct 31 20:18:28 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 31 Oct 2009 16:18:28 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N4KP6-00011y-IE@common-lisp.net>

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

Modified Files:
	swank-c-p-c.lisp swank-arglists.lisp slime-c-p-c.el ChangeLog 
Log Message:
	* swank-c-p-c.lisp (completion-set): Split into
	`symbol-completion-set', and `package-completion-set'.
	(completions): Updated accordingly. Also: complete packages
	"hyphenated" by dots.
	(find-matching-packages): Heed readtable-case.
	(make-compound-prefix-matcher): Make it possible to pass list of
	delimeters.
	(compound-prefix-match): Deleted.

	* swank-arglists.lisp (completions-for-keyword): Adapted so it
	does not use `compound-prefix-match'.

	* slime-c-p-c.el (complete-symbol* [test]): New test case.


--- /project/slime/cvsroot/slime/contrib/swank-c-p-c.lisp	2008/11/22 12:19:26	1.3
+++ /project/slime/cvsroot/slime/contrib/swank-c-p-c.lisp	2009/10/31 20:18:28	1.4
@@ -41,29 +41,39 @@
   PKG:FOO  - Symbols with matching prefix and external in package PKG.
   PKG::FOO - Symbols with matching prefix and accessible in package PKG.
 "
-  (let ((completion-set (completion-set string default-package-name
-                                        #'compound-prefix-match)))
-    (when completion-set
-      (list completion-set (longest-compound-prefix completion-set)))))
+  (multiple-value-bind (name package-name package internal-p)
+      (parse-completion-arguments string default-package-name)
+    (let* ((symbol-set  (symbol-completion-set 
+			 name package-name package internal-p
+			 (make-compound-prefix-matcher #\-)))
+	   (package-set (package-completion-set 
+			 name package-name package internal-p
+			 (make-compound-prefix-matcher '(#\. #\-))))
+	   (completion-set
+	    (format-completion-set (nconc symbol-set package-set) 
+				   internal-p package-name)))
+      (when completion-set
+	(list completion-set (longest-compound-prefix completion-set))))))
+
 
 ;;;;; Find completion set
 
-(defun completion-set (string default-package-name matchp)
+(defun symbol-completion-set (name package-name package internal-p matchp)
   "Return the set of completion-candidates as strings."
-  (multiple-value-bind (name package-name package internal-p)
-      (parse-completion-arguments string default-package-name)
-    (let* ((symbols (mapcar (completion-output-symbol-converter name)
-                            (and package
-                                 (mapcar #'symbol-name
-                                         (find-matching-symbols name
-                                                                package
-                                                                (and (not internal-p)
-                                                                     package-name)
-                                                                matchp)))))
-           (packs (mapcar (completion-output-package-converter name)
-                          (and (not package-name)
-                               (find-matching-packages name matchp)))))
-      (format-completion-set (nconc symbols packs) internal-p package-name))))
+  (mapcar (completion-output-symbol-converter name)
+	  (and package
+	       (mapcar #'symbol-name
+		       (find-matching-symbols name
+					      package
+					      (and (not internal-p)
+						   package-name)
+					      matchp)))))
+
+(defun package-completion-set (name package-name package internal-p matchp)
+  (declare (ignore package internal-p))
+  (mapcar (completion-output-package-converter name)
+	  (and (not package-name)
+	       (find-matching-packages name matchp))))
 
 (defun find-matching-symbols (string package external test)
   "Return a list of symbols in PACKAGE matching STRING.
@@ -97,13 +107,13 @@
 (defun find-matching-packages (name matcher)
   "Return a list of package names matching NAME with MATCHER.
 MATCHER is a two-argument predicate."
-  (let ((to-match (string-upcase name)))
-    (remove-if-not (lambda (x) (funcall matcher to-match x))
+  (let ((converter (completion-output-package-converter name)))
+    (remove-if-not (lambda (x)
+                     (funcall matcher name (funcall converter x)))
                    (mapcar (lambda (pkgname)
                              (concatenate 'string pkgname ":"))
                            (loop for package in (list-all-packages)
-                                 collect (package-name package)
-                                 append (package-nicknames package))))))
+                                 nconcing (package-names package))))))
 
 
 ;; PARSE-COMPLETION-ARGUMENTS return table:
@@ -212,24 +222,23 @@
 Viewing each of `prefix' and `target' as a series of substrings
 delimited by DELIMETER, if each substring of `prefix' is a prefix
 of the corresponding substring in `target' then we call `prefix'
-a compound-prefix of `target'."
-  (lambda (prefix target)
-    (declare (type simple-string prefix target))
-    (loop for ch across prefix
-          with tpos = 0
-          always (and (< tpos (length target))
-                      (if (char= ch delimeter)
-                          (setf tpos (position #\- target :start tpos))
-                          (funcall test ch (aref target tpos))))
-          do (incf tpos))))
-
-(defun compound-prefix-match (prefix target)
-  "Examples:
-\(compound-prefix-match \"foo\" \"foobar\") => t
-\(compound-prefix-match \"m--b\" \"multiple-value-bind\") => t
-\(compound-prefix-match \"m-v-c\" \"multiple-value-bind\") => NIL
-"
-  (funcall (make-compound-prefix-matcher #\-) prefix target))
+a compound-prefix of `target'.
+
+DELIMETER may be a character, or a list of characters."
+  (let ((delimeters (etypecase delimeter
+		      (character (list delimeter))
+		      (cons      (assert (every #'characterp delimeter))
+			         delimeter))))
+    (lambda (prefix target)
+      (declare (type simple-string prefix target))
+      (loop for ch across prefix
+	    with tpos = 0
+	    always (and (< tpos (length target))
+			(let ((delimeter (car (member ch delimeters :test test))))
+			  (if delimeter
+			      (setf tpos (position delimeter target :start tpos))
+			      (funcall test ch (aref target tpos)))))
+	    do (incf tpos)))))
 
 
 ;;;;; Extending the input string by completion
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/10/31 19:38:28	1.35
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/10/31 20:18:28	1.36
@@ -1329,8 +1329,8 @@
 			    (keyword-name
 			     (tokenize-symbol keyword-string))
 			    (matching-keywords
-			     (find-matching-symbols-in-list keyword-name keywords
-							    #'compound-prefix-match))
+			     (find-matching-symbols-in-list 
+			      keyword-name keywords (make-compound-prefix-matcher #\-)))
 			    (converter (completion-output-symbol-converter keyword-string))
 			    (strings
 			     (mapcar converter
--- /project/slime/cvsroot/slime/contrib/slime-c-p-c.el	2009/08/28 23:50:48	1.12
+++ /project/slime/cvsroot/slime/contrib/slime-c-p-c.el	2009/10/31 20:18:28	1.13
@@ -201,4 +201,22 @@
   (while slime-c-p-c-init-undo-stack
     (eval (pop slime-c-p-c-init-undo-stack))))
 
+(def-slime-test complete-symbol*
+    (prefix expected-completions)
+    "Find the completions of a symbol-name prefix."
+    '(("cl:compile" (("cl:compile" "cl:compile-file" "cl:compile-file-pathname"
+                      "cl:compiled-function" "cl:compiled-function-p" 
+                      "cl:compiler-macro" "cl:compiler-macro-function")
+                     "cl:compile"))
+      ("cl:foobar" nil)
+      ("swank::compile-file" (("swank::compile-file" 
+                               "swank::compile-file-for-emacs"
+                               "swank::compile-file-if-needed"
+                               "swank::compile-file-pathname")
+                              "swank::compile-file"))
+      ("cl:m-v-l" (("cl:multiple-value-list" "cl:multiple-values-limit") "cl:multiple-value"))
+      ("common-lisp" (("common-lisp-user:" "common-lisp:") "common-lisp")))
+  (let ((completions (slime-completions prefix)))
+    (slime-test-expect "Completion set" expected-completions completions)))
+
 (provide 'slime-c-p-c)
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/31 19:38:28	1.263
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/31 20:18:28	1.264
@@ -1,5 +1,21 @@
 2009-10-31  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* swank-c-p-c.lisp (completion-set): Split into
+	`symbol-completion-set', and `package-completion-set'.
+	(completions): Updated accordingly. Also: complete packages
+	"hyphenated" by dots.
+	(find-matching-packages): Heed readtable-case.
+	(make-compound-prefix-matcher): Make it possible to pass list of
+	delimeters.
+	(compound-prefix-match): Deleted.
+
+	* swank-arglists.lisp (completions-for-keyword): Adapted so it
+	does not use `compound-prefix-match'.
+
+	* slime-c-p-c.el (complete-symbol* [test]): New test case.
+
+2009-10-31  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* swank-arglists.lisp (extra-keywords :around): Sort keyword
 	parameters such that implementation-internal stuff is shown last.
 	(compose): New helper.




From trittweiler at common-lisp.net  Sat Oct 31 20:47:13 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 31 Oct 2009 16:47:13 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N4Kqv-0003PA-Ap@common-lisp.net>

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

Modified Files:
	swank.lisp ChangeLog 
Log Message:
	* swank.lisp (find-symbol-with-status): New.
	(parse-symbol): Use it to correctly parse symbols where only one
	colon is given. Consequences: Autodoc won't display an arglist on
	`(foo:bar |' if BAR is not exported from FOO.


--- /project/slime/cvsroot/slime/swank.lisp	2009/10/31 08:54:46	1.667
+++ /project/slime/cvsroot/slime/swank.lisp	2009/10/31 20:47:13	1.668
@@ -2048,15 +2048,26 @@
                  (char-downcase char)
                  (char-upcase char)))))
 
+
+(defun find-symbol-with-status (symbol-name status &optional (package *package*))
+  (multiple-value-bind (symbol flag) (find-symbol symbol-name package)
+    (if (and flag (eq flag status))
+        (values symbol flag)
+        (values nil nil))))
+
 (defun parse-symbol (string &optional (package *package*))
   "Find the symbol named STRING.
 Return the symbol and a flag indicating whether the symbols was found."
-  (multiple-value-bind (sname pname) (tokenize-symbol-thoroughly string)
+  (multiple-value-bind (sname pname internalp)
+      (tokenize-symbol-thoroughly string)
     (let ((package (cond ((string= pname "") keyword-package)
                          (pname              (find-package pname))
                          (t                  package))))
       (if package
-          (multiple-value-bind (symbol flag) (find-symbol sname package)
+          (multiple-value-bind (symbol flag)
+              (if internalp
+                  (find-symbol sname package)
+                  (find-symbol-with-status sname ':external package))
             (values symbol flag sname package))
           (values nil nil nil nil)))))
 
--- /project/slime/cvsroot/slime/ChangeLog	2009/10/31 08:54:45	1.1900
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/31 20:47:13	1.1901
@@ -1,3 +1,10 @@
+2009-10-31  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp (find-symbol-with-status): New.
+	(parse-symbol): Use it to correctly parse symbols where only one
+	colon is given. Consequences: Autodoc won't display an arglist on
+	`(foo:bar |' if BAR is not exported from FOO.
+
 2009-10-31  Helmut Eller  <heller at common-lisp.net>
 
 	* swank.lisp (list-threads): Remove thread-description.  Wasn't




From trittweiler at common-lisp.net  Sat Oct 31 21:31:49 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 31 Oct 2009 17:31:49 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N4LY5-00071P-GT@common-lisp.net>

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

Modified Files:
	swank-arglists.lisp slime-autodoc.el ChangeLog 
Log Message:
	* slime-autodoc.el (slime-autodoc-worthwile-p): New helper.
	(slime-compute-autodoc-internal): Use it to only perform an RPC
	request if it's worthwhile to do so. For example, don't do it if
	the user only typed a single opening parenthesis.

	* swank-arglists.lisp (variable-desc-for-echo-area):
	Bind *PRINT-READABLY* to NIL as global variables may contain
	objects which can't be printed readably.


--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/10/31 20:18:28	1.36
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/10/31 21:31:49	1.37
@@ -498,7 +498,8 @@
     (let ((sym (parse-symbol variable-name)))
       (if (and sym (boundp sym))
           (let ((*print-pretty* t) (*print-level* 4)
-                (*print-length* 10) (*print-lines* 1))
+                (*print-length* 10) (*print-lines* 1)
+		(*print-readably* nil))
 	    (call/truncated-output-to-string 
 	     75 (lambda (s)
 		  (format s "~A => ~S" sym (symbol-value sym)))))))))
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/09/15 17:34:32	1.20
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/10/31 21:31:49	1.21
@@ -206,17 +206,25 @@
 background everytime a new autodoc is computed. The hook is
 applied to the result of `slime-enclosing-form-specs'.")
 
+(defun slime-autodoc-worthwhile-p (ops)
+  ;; Prevent an RPC call for when the user solely typed in an opening
+  ;; parenthesis.
+  (and (not (null ops))
+       (or (not (null (first ops)))
+	   (slime-length> ops 1))))
+
 (defun slime-compute-autodoc-internal ()
   "Returns the cached arglist information as string, or nil.
 If it's not in the cache, the cache will be updated asynchronously."
   (multiple-value-bind (ops arg-indices points)
       (slime-enclosing-form-specs)
-    (run-hook-with-args 'slime-autodoc-hook ops arg-indices points)
-    (multiple-value-bind (cache-key retrieve-form)
-        (slime-compute-autodoc-rpc-form ops arg-indices points)
-      (let ((cached (slime-get-cached-autodoc cache-key)))
-        (if cached
-            cached
+    (when (slime-autodoc-worthwhile-p ops)
+      (run-hook-with-args 'slime-autodoc-hook ops arg-indices points)
+      (multiple-value-bind (cache-key retrieve-form)
+	  (slime-compute-autodoc-rpc-form ops arg-indices points)
+	(let ((cached (slime-get-cached-autodoc cache-key)))
+	  (if cached
+	      cached
             ;; If nothing is in the cache, we first decline, and fetch
             ;; the arglist information asynchronously.
             (prog1 nil
@@ -227,7 +235,7 @@
                       ;; Now that we've got our information, get it to
                       ;; the user ASAP.
                       (eldoc-message doc)
-                      (slime-store-into-autodoc-cache cache-key doc)))))))))))
+                      (slime-store-into-autodoc-cache cache-key doc))))))))))))
 
 (defun slime-compute-autodoc ()
   (save-excursion
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/31 20:18:28	1.264
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/31 21:31:49	1.265
@@ -1,5 +1,16 @@
 2009-10-31  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* slime-autodoc.el (slime-autodoc-worthwile-p): New helper.
+	(slime-compute-autodoc-internal): Use it to only perform an RPC
+	request if it's worthwhile to do so. For example, don't do it if
+	the user only typed a single opening parenthesis.
+
+	* swank-arglists.lisp (variable-desc-for-echo-area):
+	Bind *PRINT-READABLY* to NIL as global variables may contain
+	objects which can't be printed readably.
+
+2009-10-31  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* swank-c-p-c.lisp (completion-set): Split into
 	`symbol-completion-set', and `package-completion-set'.
 	(completions): Updated accordingly. Also: complete packages




From trittweiler at common-lisp.net  Sat Oct 31 22:13:55 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 31 Oct 2009 18:13:55 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N4MCp-0001Zz-8I@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank-loader.lisp swank.lisp 
Added Files:
	swank-match.lisp 
Log Message:
	* slime.el (slime-inside-string-p, slime-inside-comment-p)
	(slime-inside-string-or-comment-p): New.

	* swank-match.lisp: New file. Contains very simple pattern matcher
	from the CMU AI archive.

	* swank-loader.lisp: Compile swank-match.lisp.

	* swank.lisp: Make SWANK package use new SWANK-MATCH package.

	* slime-autodoc.el, swank-arglists.lisp: Large parts were
	rewritten. Autodoc is now able to highlight &key parameters, and
	parameters in nested arglists.

	* slime-parse.el, slime-c-p-c.el, slime-highlighting-edits.el:
	Adapted to changes.


--- /project/slime/cvsroot/slime/ChangeLog	2009/10/31 20:47:13	1.1901
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/31 22:13:54	1.1902
@@ -1,5 +1,17 @@
 2009-10-31  Tobias C. Rittweiler <tcr at freebits.de>
 
+	* slime.el (slime-inside-string-p, slime-inside-comment-p)
+	(slime-inside-string-or-comment-p): New.
+
+	* swank-match.lisp: New file. Contains very simple pattern matcher
+	from the CMU AI archive.
+
+	* swank-loader.lisp: Compile swank-match.lisp.
+
+	* swank.lisp: Make SWANK package use new SWANK-MATCH package.
+
+2009-10-31  Tobias C. Rittweiler <tcr at freebits.de>
+
 	* swank.lisp (find-symbol-with-status): New.
 	(parse-symbol): Use it to correctly parse symbols where only one
 	colon is given. Consequences: Autodoc won't display an arglist on
--- /project/slime/cvsroot/slime/slime.el	2009/10/31 08:54:45	1.1243
+++ /project/slime/cvsroot/slime/slime.el	2009/10/31 22:13:54	1.1244
@@ -8218,6 +8218,18 @@
           until (= (point) (point-max))
           maximizing column)))
 
+(defun slime-inside-string-p ()
+  (nth 3 (slime-current-parser-state)))
+
+(defun slime-inside-comment-p ()
+  (nth 4 (slime-current-parser-state)))
+
+(defun slime-inside-string-or-comment-p ()
+  (let ((state (slime-current-parser-state)))
+    (or (nth 3 state) (nth 4 state))))
+
+
+
 ;;;;; CL symbols vs. Elisp symbols.
 
 (defun slime-cl-symbol-name (symbol)
--- /project/slime/cvsroot/slime/swank-loader.lisp	2009/10/30 19:39:34	1.94
+++ /project/slime/cvsroot/slime/swank-loader.lisp	2009/10/31 22:13:55	1.95
@@ -182,7 +182,7 @@
                            :defaults src-dir))
           names))
 
-(defvar *swank-files* `(swank-backend ,@*sysdep-files* swank))
+(defvar *swank-files* `(swank-backend ,@*sysdep-files* swank-match swank))
 
 (defvar *contribs* '(swank-c-p-c swank-arglists swank-fuzzy
                      swank-fancy-inspector
--- /project/slime/cvsroot/slime/swank.lisp	2009/10/31 20:47:13	1.668
+++ /project/slime/cvsroot/slime/swank.lisp	2009/10/31 22:13:55	1.669
@@ -13,7 +13,7 @@
 ;;; available to us here via the `SWANK-BACKEND' package.
 
 (defpackage :swank
-  (:use :cl :swank-backend)
+  (:use :cl :swank-backend :swank-match)
   (:export #:startup-multiprocessing
            #:start-server 
            #:create-server
@@ -478,11 +478,11 @@
 	    (,operands (cdr ,tmp)))
        (case ,operator
          ,@(loop for (pattern . body) in patterns collect 
-                   (if (eq pattern t)
-                       `(t , at body)
-                       (destructuring-bind (op &rest rands) pattern
-                         `(,op (destructuring-bind ,rands ,operands 
-                                 , at body)))))
+                 (if (eq pattern t)
+                     `(t , at body)
+                     (destructuring-bind (op &rest rands) pattern
+                       `(,op (destructuring-bind ,rands ,operands 
+                               , at body)))))
          ,@(if (eq (caar (last patterns)) t)
                '()
                `((t (error "destructure-case failed: ~S" ,tmp))))))))
@@ -1232,6 +1232,7 @@
                                  (cdr tail)))
       tail)))
 
+;;; FIXME: Make this use SWANK-MATCH.
 (defun event-match-p (event pattern)
   (cond ((or (keywordp pattern) (numberp pattern) (stringp pattern)
 	     (member pattern '(nil t)))

--- /project/slime/cvsroot/slime/swank-match.lisp	2009/10/31 22:13:55	NONE
+++ /project/slime/cvsroot/slime/swank-match.lisp	2009/10/31 22:13:55	1.1
;;
;;  SELECT-MATCH macro (and IN macro)
;;
;; Copyright 1990   Stephen Adams
;;
;; You are free to copy, distribute and make derivative works of this
;; source provided that this copyright notice is displayed near the
;; beginning of the file.  No liability is accepted for the
;; correctness or performance of the code.  If you modify the code
;; please indicate this fact both at the place of modification and in
;; this copyright message.
;;
;;   Stephen Adams
;;   Department of Electronics and Computer Science
;;   University of Southampton
;;   SO9 5NH, UK
;;
;; sra at ecs.soton.ac.uk
;;

;;
;;  Synopsis:
;;
;;  (select-match expression
;;      (pattern  action+)*
;;  )
;;
;;      --- or ---
;;
;;  (select-match expression
;;      pattern => expression
;;      pattern => expression
;;      ...
;;  )
;;
;;  pattern ->  constant		;egs  1, #\x, #c(1.0 1.1)
;;          |   symbol                  ;matches anything
;;          |   'anything               ;must be EQUAL
;;          |   (pattern = pattern)     ;both patterns must match
;;          |   (#'function pattern)    ;predicate test
;;          |   (pattern . pattern)	;cons cell
;;

;;  Example
;;
;;  (select-match item
;;      (('if e1 e2 e3) 'if-then-else)				;(1)
;;      ((#'oddp k)     'an-odd-integer)			;(2)
;;      (((#'treep tree) = (hd . tl))   'something-else)	;(3)
;;      (other          'anything-else))			;(4)
;;
;;  Notes
;;
;;  .   Each pattern is tested in turn.  The first match is taken.
;;
;;  .   If no pattern matches, an error is signalled.
;;
;;  .   Constant patterns (things X for which (CONSTANTP X) is true, i.e.
;;      numbers, strings, characters, etc.) match things which are EQUAL.
;;
;;  .   Quoted patterns (which are CONSTANTP) are constants.
;;
;;  .   Symbols match anything. The symbol is bound to the matched item
;;      for the execution of the actions.
;;      For example, (SELECT-MATCH '(1 2 3)
;;                      (1 . X) => X
;;                   )
;;      returns (2 3) because X is bound to the cdr of the candidate.
;;
;;  .   The two pattern match (p1 = p2) can be used to name parts
;;      of the matched structure.  For example, (ALL = (HD . TL))
;;      matches a cons cell. ALL is bound to the cons cell, HD to its car
;;      and TL to its tail.
;;
;;  .   A predicate test applies the predicate to the item being matched.
;;      If the predicate returns NIL then the match fails.
;;      If it returns truth, then the nested pattern is matched.  This is
;;      often just a symbol like K in the example.
;;
;;  .   Care should be taken with the domain values for predicate matches.
;;      If, in the above eg, item is not an integer, an error would occur
;;      during the test.  A safer pattern would be
;;          (#'integerp (#'oddp k))
;;      This would only test for oddness of the item was an integer.
;;
;;  .   A single symbol will match anything so it can be used as a default
;;      case, like OTHER above.
;;

(defpackage :swank-match
  (:use :cl)
  (:export #:match))

(in-package :swank-match)

(defmacro match (expression &body patterns)
  `(select-match ,expression , at patterns))

(defmacro select-match (expression &rest patterns)
    (let* ( (do-let (not (atom expression)))
            (key    (if do-let (gensym) expression))
            (cbody  (expand-select-patterns key patterns))
            (cform  `(cond . ,cbody))
          )

        (if do-let
            `(let ((,key ,expression)) ,cform)
            cform))
)


(defun expand-select-patterns (key patterns)
    (if (eq (second patterns) '=>)
        (expand-select-patterns-style-2 key patterns)
        (expand-select-patterns-style-1 key patterns)))


(defun expand-select-patterns-style-1 (key patterns)

  (if (null patterns)
  
    `((t (error "Case select pattern match failure on ~S" ,key)))

    (let ((pattern  (caar patterns))
          (actions  (cdar patterns))
          (rest     (cdr patterns)) )

        (let  ( (test       (compile-select-test key pattern))
                (bindings   (compile-select-bindings key pattern actions)))

            `(  ,(if bindings  `(,test (let ,bindings . ,actions))
                               `(,test . ,actions))
              . ,(if (eq test t)
                    nil
                    (expand-select-patterns-style-1 key rest)))
        )
    )
))



(defun expand-select-patterns-style-2 (key patterns)

  (if (null patterns)
  
    `((t (error "Case select pattern match failure on ~S" ,key)))

    (let ((pattern  (first patterns))
          (arrow    (if (or (< (length patterns) 3)
                            (not (eq (second patterns) '=>)))
                        (error "Illegal patterns: ~S" patterns)))
          (actions  (list (third patterns)))
          (rest     (cdddr patterns)) )

        (let  ( (test       (compile-select-test key pattern))
                (bindings   (compile-select-bindings key pattern actions)))

            `(  ,(if bindings  `(,test (let ,bindings . ,actions))
                               `(,test . ,actions))
              . ,(if (eq test t)
                    nil
                    (expand-select-patterns-style-2 key rest)))
        )
    )
))



(defun compile-select-test (key pattern)
    (let  ((tests (remove-if
                        #'(lambda (item) (eq item t))
                        (compile-select-tests key pattern))))
        (cond
            ;; note AND does this anyway, but this allows us to tell if
            ;; the pattern will always match.
            ((null tests)           t)
            ((= (length tests) 1)   (car tests))
            (t                      `(and . ,tests)))))


(defun compile-select-tests (key pattern)

  (cond   ((constantp pattern)   `((,(cond ((numberp pattern) 'eql)
                                           ((symbolp pattern) 'eq)
                                           (t                'equal))
                                     ,key ,pattern)))

        ((symbolp pattern)      '(t))

        ((select-double-match? pattern)
         (append
          (compile-select-tests key (first pattern))
          (compile-select-tests key (third pattern))))

        ((select-predicate? pattern)
         (append
          `((,(second (first pattern)) ,key))
          (compile-select-tests key (second pattern))))

        ((consp pattern)
         (append
          `((consp ,key))
          (compile-select-tests (!cs-car key) (car
                                               pattern))
          (compile-select-tests (!cs-cdr key) (cdr
                                               pattern))))

        (t         (error "Illegal select pattern: ~S" pattern))
        )
  )


(defun compile-select-bindings (key pattern action)

  (cond   ((constantp pattern)    '())
        ((symbolp pattern)
         (if (select!-in-tree pattern action) `((,pattern ,key))
             '()))

        ((select-double-match? pattern)
         (append
          (compile-select-bindings key (first pattern) action)
          (compile-select-bindings key (third pattern)
                                   action)))

        ((select-predicate? pattern)
         (compile-select-bindings key (second pattern)
                                  action))

        ((consp pattern)
         (append
          (compile-select-bindings (!cs-car key) (car pattern)
                                   action)
          (compile-select-bindings (!cs-cdr key) (cdr pattern)
                                   action)))
        )
  )


(defun select!-in-tree (atom tree)
    (or (eq atom tree)
        (if (consp tree)
            (or (select!-in-tree atom (car tree))
                (select!-in-tree atom (cdr tree))))))

(defun select-double-match? (pattern)
    ;;  (<pattern> = <pattern>)
    (and (consp pattern) (consp (cdr pattern)) (consp (cddr pattern))
         (null (cdddr pattern))
         (eq (second pattern) '=)))


(defun select-predicate? (pattern)
    ;; ((function <f>) <pattern>)
    (and    (consp pattern)
            (consp (cdr pattern))
            (null (cddr pattern))
            (consp (first pattern))
            (consp (cdr (first pattern)))
            (null (cddr (first pattern)))
            (eq (caar pattern) 'function)))




(defun !cs-car (exp)
    (!cs-car/cdr 'car exp '(
            (car . caar)    (cdr . cadr)    (caar . caaar)  (cadr . caadr)
            (cdar . cadar)  (cddr . caddr)
            (caaar . caaaar)    (caadr . caaadr)    (cadar . caadar)
            (caddr . caaddr)    (cdaar . cadaar)    (cdadr . cadadr)
            (cddar . caddar)    (cdddr . cadddr))))

(defun !cs-cdr (exp)
    (!cs-car/cdr 'cdr exp '(
            (car . cdar)    (cdr . cddr)    (caar . cdaar)  (cadr . cdadr)
            (cdar . cddar)  (cddr . cdddr)
            (caaar . cdaaar)    (caadr . cdaadr)    (cadar . cdadar)
            (caddr . cdaddr)    (cdaar . cddaar)    (cdadr . cddadr)
            (cddar . cdddar)    (cdddr . cddddr))))

(defun !cs-car/cdr (op exp table)
    (if (and (consp exp) (= (length exp) 2))
        (let ((replacement  (assoc (car exp) table)))
            (if replacement
                `(,(cdr replacement) ,(second exp))
                `(,op ,exp)))
        `(,op ,exp)))

;; (setf c1 '(select-match x (a 1) (b 2 3 4)))
;; (setf c2 '(select-match (car y)
;;             (1 (print 100) 101) (2 200) ("hello" 5) (:x 20) (else (1+
;;  else))))
;; (setf c3 '(select-match (caddr y)
;;             ((all = (x y)) (list x y all))
;;             ((a '= b)      (list 'assign a b))
;;             ((#'oddp k)     (1+ k)))))





From trittweiler at common-lisp.net  Sat Oct 31 22:13:55 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 31 Oct 2009 18:13:55 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N4MCp-0001aS-MX@common-lisp.net>

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

Modified Files:
	ChangeLog slime-autodoc.el slime-c-p-c.el 
	slime-highlight-edits.el slime-parse.el swank-arglists.lisp 
Log Message:
	* slime.el (slime-inside-string-p, slime-inside-comment-p)
	(slime-inside-string-or-comment-p): New.

	* swank-match.lisp: New file. Contains very simple pattern matcher
	from the CMU AI archive.

	* swank-loader.lisp: Compile swank-match.lisp.

	* swank.lisp: Make SWANK package use new SWANK-MATCH package.

	* slime-autodoc.el, swank-arglists.lisp: Large parts were
	rewritten. Autodoc is now able to highlight &key parameters, and
	parameters in nested arglists.

	* slime-parse.el, slime-c-p-c.el, slime-highlighting-edits.el:
	Adapted to changes.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/31 21:31:49	1.265
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/31 22:13:55	1.266
@@ -1,5 +1,14 @@
 2009-10-31  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* slime-autodoc.el, swank-arglists.lisp: Large parts were
+	rewritten. Autodoc is now able to highlight &key parameters, and
+	parameters in nested arglists.
+
+	* slime-parse.el, slime-c-p-c.el, slime-highlighting-edits.el:
+	Adapted to changes.
+
+2009-10-31  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* slime-autodoc.el (slime-autodoc-worthwile-p): New helper.
 	(slime-compute-autodoc-internal): Use it to only perform an RPC
 	request if it's worthwhile to do so. For example, don't do it if
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/10/31 21:31:49	1.21
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/10/31 22:13:55	1.22
@@ -31,7 +31,7 @@
   :type 'boolean
   :group 'slime-ui)
 
-(defcustom slime-autodoc-delay 0.2
+(defcustom slime-autodoc-delay 0.3
   "*Delay before autodoc messages are fetched and displayed, in seconds."
   :type 'number
   :group 'slime-ui)
@@ -53,16 +53,23 @@
   "Not used; for debugging purposes."
   (multiple-value-bind (operators arg-indices points)
 	    (slime-enclosing-form-specs)
-    (slime-compute-autodoc-rpc-form operators arg-indices points)))
+    (slime-make-autodoc-rpc-form operators arg-indices points)))
 
-(defun slime-compute-autodoc-rpc-form (operators arg-indices points)
+;; TODO: get rid of args
+(defun slime-make-autodoc-rpc-form (operators arg-indices points)
   "Return a cache key and a swank form."
-  (let ((global (slime-autodoc-global-at-point)))
-    (if global
-        (values (slime-qualify-cl-symbol-name global)
-                `(swank:variable-desc-for-echo-area ,global))
-	(values (slime-make-autodoc-cache-key operators arg-indices points)
-                (slime-make-autodoc-swank-form operators arg-indices points)))))
+  (unless (slime-inside-string-or-comment-p)
+    (let ((global (slime-autodoc-global-at-point)))
+      (if global
+          (values (slime-qualify-cl-symbol-name global)
+                  `(swank:variable-desc-for-echo-area ,global))
+          (let ((buffer-form (slime-parse-form-upto-point 10)))
+            (values buffer-form
+                    (multiple-value-bind (width height)
+                        (slime-autodoc-message-dimensions)
+                      `(swank:arglist-for-echo-area ',buffer-form
+                        :print-right-margin ,width
+                        :print-lines ,height))))))))
 
 (defun slime-autodoc-global-at-point ()
   "Return the global variable name at point, if any."
@@ -82,37 +89,6 @@
   (and (< (length name) 80) ; avoid overflows in regexp matcher
        (string-match slime-global-variable-name-regexp name)))
 
-(defun slime-make-autodoc-cache-key (ops indices points)
-  (mapcar* (lambda (designator arg-index)
-	     (let ((designator (if (symbolp designator)
-				   (slime-qualify-cl-symbol-name designator)
-				   designator)))
-	       `(,designator . ,arg-index)))
-	   operators arg-indices))
-
-(defun slime-make-autodoc-swank-form (ops indices points)
-  (multiple-value-bind (width height)
-      (slime-autodoc-message-dimensions)
-    (let ((local-arglist (slime-autodoc-local-arglist ops indices points)))
-      (if local-arglist
-	  `(swank:format-arglist-for-echo-area ,local-arglist
-	     :operator ,(first (first ops))
-	     :highlight ,(if (zerop (first indices)) nil (first indices))
-	     :print-right-margin ,width
-	     :print-lines ,height)
-	  `(swank:arglist-for-echo-area ',ops 
-	     :arg-indices ',indices
-	     :print-right-margin ,width
-	     :print-lines ,height)))))
-
-(defun slime-autodoc-local-arglist (ops indices points)
-  (let* ((cur-op      (first ops))
-	 (cur-op-name (first cur-op)))
-    (multiple-value-bind (bound-fn-names arglists)
-	(slime-find-bound-functions ops indices points)
-      (when-let (pos (position cur-op-name bound-fn-names :test 'equal))
-	(nth pos arglists)))))
-
 (defvar slime-autodoc-dimensions-function nil)
 
 (defun slime-autodoc-message-dimensions ()
@@ -221,7 +197,7 @@
     (when (slime-autodoc-worthwhile-p ops)
       (run-hook-with-args 'slime-autodoc-hook ops arg-indices points)
       (multiple-value-bind (cache-key retrieve-form)
-	  (slime-compute-autodoc-rpc-form ops arg-indices points)
+	  (slime-make-autodoc-rpc-form ops arg-indices points)
 	(let ((cached (slime-get-cached-autodoc cache-key)))
 	  (if cached
 	      cached
@@ -231,7 +207,10 @@
               (slime-eval-async retrieve-form
                 (lexical-let ((cache-key cache-key)) 
                   (lambda (doc)
-                    (let ((doc (if doc (slime-format-autodoc doc) "")))
+                    (let ((doc (if (or (null doc)
+				       (eq doc :not-available))
+				   ""
+				   (slime-format-autodoc doc))))
                       ;; Now that we've got our information, get it to
                       ;; the user ASAP.
                       (eldoc-message doc)
--- /project/slime/cvsroot/slime/contrib/slime-c-p-c.el	2009/10/31 20:18:28	1.13
+++ /project/slime/cvsroot/slime/contrib/slime-c-p-c.el	2009/10/31 22:13:55	1.14
@@ -112,21 +112,18 @@
   (let ((token (buffer-substring-no-properties beg end)))
     (cond
      ((and (< beg (point-max))
-               (string= (buffer-substring-no-properties beg (1+ beg)) ":"))
+           (string= (buffer-substring-no-properties beg (1+ beg)) ":"))
       ;; Contextual keyword completion
-      (multiple-value-bind (operator-names arg-indices points)
-          (save-excursion 
-            (goto-char beg)
-            (slime-enclosing-form-specs))
-        (when operator-names
-          (let ((completions 
-                 (slime-completions-for-keyword operator-names token
-                                                arg-indices)))
-            (when (first completions)
-              (return-from slime-contextual-completions completions))
-            ;; If no matching keyword was found, do regular symbol
-            ;; completion.
-            ))))
+      (let ((completions 
+             (slime-completions-for-keyword token
+                                            (save-excursion 
+                                              (goto-char beg)
+                                              (slime-parse-form-upto-point)))))
+        (when (first completions)
+          (return-from slime-contextual-completions completions))
+        ;; If no matching keyword was found, do regular symbol
+        ;; completion.
+        ))
      ((and (>= (length token) 2)
            (string= (subseq token 0 2) "#\\"))
       ;; Character name completion
@@ -138,11 +135,8 @@
 (defun slime-completions (prefix)
   (slime-eval `(swank:completions ,prefix ',(slime-current-package))))
 
-(defun slime-completions-for-keyword (operator-designator prefix
-                                                          arg-indices)
-  (slime-eval `(swank:completions-for-keyword ',operator-designator
-					      ,prefix
-					      ',arg-indices)))
+(defun slime-completions-for-keyword (prefix buffer-form)
+  (slime-eval `(swank:completions-for-keyword ,prefix ',buffer-form)))
 
 (defun slime-completions-for-character (prefix)
   (flet ((append-char-syntax (string) (concat "#\\" string)))
@@ -160,17 +154,14 @@
 This is a superset of the functionality of `slime-insert-arglist'."
   (interactive)
   ;; Find the (possibly incomplete) form around point.
-  (let ((form-string (slime-incomplete-form-at-point)))
-    (let ((result (slime-eval `(swank:complete-form ',form-string))))
+  (let ((buffer-form (slime-parse-form-upto-point)))
+    (let ((result (slime-eval `(swank:complete-form ',buffer-form))))
       (if (eq result :not-available)
-          (error "Could not generate completion for the form `%s'" form-string)
+          (error "Could not generate completion for the form `%s'" buffer-form)
           (progn
-            (just-one-space)
+            (just-one-space (if (looking-back "\\s(") 0 1))
             (save-excursion
-              ;; SWANK:COMPLETE-FORM always returns a closing
-              ;; parenthesis; but we only want to insert one if it's
-              ;; really necessary (thinking especially of paredit.el.)
-              (insert (substring result 0 -1))
+              (insert result)
               (let ((slime-close-parens-limit 1))
                 (slime-close-all-parens-in-sexp)))
             (save-excursion
--- /project/slime/cvsroot/slime/contrib/slime-highlight-edits.el	2007/09/20 14:55:53	1.3
+++ /project/slime/cvsroot/slime/contrib/slime-highlight-edits.el	2009/10/31 22:13:55	1.4
@@ -45,7 +45,7 @@
 (defun slime-highlight-edits (beg end &optional len) 
   (save-match-data
     (when (and (slime-connected-p)
-               (not (slime-inside-comment-p beg end))
+               (not (slime-inside-comment-p))
                (not (slime-only-whitespace-p beg end)))
       (let ((overlay (make-overlay beg end)))
         (overlay-put overlay 'face 'slime-highlight-edits-face)
@@ -71,16 +71,6 @@
 			       (point))))
       (slime-remove-edits start end))))
 
-(defun slime-inside-comment-p (beg end)
-  "Is the region from BEG to END in a comment?"
-  (save-excursion
-    (goto-char beg)
-    (let* ((hs-c-start-regexp ";\\|#|")
-           (comment (hs-inside-comment-p)))
-      (and comment
-           (destructuring-bind (cbeg cend) comment
-             (<= end cend))))))
-
 (defun slime-only-whitespace-p (beg end)
   "Contains the region from BEG to END only whitespace?"
   (save-excursion
--- /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/10/20 21:28:38	1.24
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/10/31 22:13:55	1.25
@@ -8,23 +8,8 @@
 ;;
 
 (defun slime-incomplete-form-at-point ()
-  "Looks for a ``raw form spec'' around point to be processed by
-SWANK::PARSE-FORM-SPEC. It is similiar to
-SLIME-INCOMPLETE-SEXP-AT-POINT but looks further back than just
-one sexp to find out the context."
-  (multiple-value-bind (operators arg-indices points)
-      (slime-enclosing-form-specs)
-    (if (null operators)
-        ""
-        (let ((op        (first operators))
-	      (op-start  (first points))
-	      (arg-index (first arg-indices)))
-          (destructure-case (slime-ensure-list op)
-            ((:declaration declspec) op)
-            ((:type-specifier typespec) op)
-            (t 
-	     (slime-make-form-spec-from-string 
-	      (concat (slime-incomplete-sexp-at-point) ")"))))))))
+  (slime-make-form-spec-from-string 
+   (concat (slime-incomplete-sexp-at-point) ")")))
 
 (defun slime-parse-sexp-at-point (&optional n skip-blanks-p)
   "Returns the sexps at point as a list of strings, otherwise nil.
@@ -246,11 +231,39 @@
 		 string
                 (let ((n (first (last indices))))
 		  (goto-char (1+ (point-min))) ; `(|OP arg1 ... argN)'
-		  (mapcar #'(lambda (s)
-			      (assert (not (equal s string))) ; trap against
-			      (slime-make-form-spec-from-string s)) ;  endless recursion.
-			  (slime-parse-sexp-at-point (1+ n) t)))))))))
+		  (let ((subsexps (slime-parse-sexp-at-point (1+ n) t)))
+		    (mapcar #'(lambda (s)
+				(assert (not (equal s string)))       ; trap against
+				(slime-make-form-spec-from-string s)) ;  endless recursion.
+			    subsexps
+			    )))))))))
 
+(defun slime-make-form-spec-from-string (string &optional strip-operator-p)
+  (cond ((slime-length= string 0) "")                    ; ""
+	((equal string "()") '())                        ; "()"
+	((eql (char-syntax (aref string 0)) ?\') string) ; "'(foo)", "#(foo)" &c
+	((not (eql (aref string 0) ?\()) string)         ; "foo"
+	(t                                               ; "(op arg1 arg2 ...)"
+	 (with-temp-buffer
+	   ;; Do NEVER ever try to activate `lisp-mode' here with
+	   ;; `slime-use-autodoc-mode' enabled, as this function is used
+	   ;; to compute the current autodoc itself.
+	   (set-syntax-table lisp-mode-syntax-table)
+	   (erase-buffer)
+	   (insert string)
+	   (goto-char (1+ (point-min)))
+	   (let ((subsexps))
+	     (while (ignore-errors (slime-forward-sexp) t)
+	       (backward-sexp)
+	       (push (slime-sexp-at-point) subsexps)
+	       (forward-sexp))
+             (mapcar #'(lambda (s)
+                         (assert (not (equal s string)))      
+                         (slime-make-form-spec-from-string s))
+                     (nreverse subsexps)))))))
+
+;;; TODO: With the rewrite of autodoc, this function like pretty much
+;;; everything else in this file, is obsolete.
 
 (defun slime-enclosing-form-specs (&optional max-levels)
   "Return the list of ``raw form specs'' of all the forms 
@@ -351,13 +364,53 @@
      (nreverse arg-indices)
      (nreverse points))))
 
+(defun slime-parse-form-upto-point (&optional max-levels)
+  ;; We assert this, because `slime-incomplete-form-at-point' blows up
+  ;; inside a comment.
+  (assert (not (slime-inside-string-or-comment-p)))
+  (save-excursion
+    (let ((char-after  (char-after))
+          (char-before (char-before))
+          (marker-suffix (list 'swank::%cursor-marker%)))
+      (cond ((and char-after (eq (char-syntax char-after) ?\())
+             ;; We're at the start of some expression, so make sure
+             ;; that SWANK::%CURSOR-MARKER% will come after that
+             ;; expression.
+             (ignore-errors (forward-sexp)))
+            ((and char-before (eq (char-syntax char-before) ?\ ))
+             ;; We're after some expression, so we have to make sure
+             ;; that %CURSOR-MARKER% does not come directly after that
+             ;; expression.
+             (push "" marker-suffix))
+            ((and char-before (eq (char-syntax char-before) ?\())
+             ;; We're directly after an opening parenthesis, so we
+             ;; have to make sure that something comes before
+             ;; %CURSOR-MARKER%..
+             (push "" marker-suffix))
+            (t
+             ;; We're at a symbol, so make sure we get the whole symbol.
+             (slime-end-of-symbol)))
+      (let ((forms '())
+            (levels (or max-levels 5)))
+        (condition-case nil
+            (let ((form (slime-incomplete-form-at-point)))
+              (setq forms (list (nconc form marker-suffix)))
+              (up-list -1)
+              (dotimes (i (1- levels))
+                (push (slime-incomplete-form-at-point) forms)
+                (up-list -1)))
+          ;; At head of toplevel form.
+          (scan-error nil))
+        (when forms
+          ;; Squeeze list of forms into tree structure again
+          (reduce #'(lambda (form tree)
+                      (nconc form (list tree)))
+                  forms :from-end t))))))
+
 
 (defun slime-ensure-list (thing)
   (if (listp thing) thing (list thing)))
 
-(defun slime-inside-string-p ()
-  (nth 3 (slime-current-parser-state)))
-
 (defun slime-beginning-of-string ()
   (let* ((parser-state (slime-current-parser-state))
 	 (inside-string-p  (nth 3 parser-state))
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/10/31 21:31:49	1.37
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/10/31 22:13:55	1.38
@@ -2,7 +2,7 @@
 ;;
 ;; Authors: Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
 ;;          Tobias C. Rittweiler <tcr at freebits.de>
-;;          and others 
+;;          and others
 ;;
 ;; License: Public Domain
 ;;
@@ -12,6 +12,8 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (swank-require :swank-c-p-c))
 
+;;;; Utilities
+
 (defun compose (&rest functions)
   "Compose FUNCTIONS right-associatively, returning a function"
   #'(lambda (x)
@@ -21,21 +23,31 @@
   "Test for whether SEQ contains N number of elements. I.e. it's equivalent
  to (= (LENGTH SEQ) N), but besides being more concise, it may also be more
  efficiently implemented."
-  (etypecase seq 
+  (etypecase seq
     (list (do ((i n (1- i))
                (list seq (cdr list)))
               ((or (<= i 0) (null list))
                (and (zerop i) (null list)))))
     (sequence (= (length seq) n))))
 
+(declaim (inline ensure-list))
 (defun ensure-list (thing)
   (if (listp thing) thing (list thing)))
 
-(defun recursively-empty-p (list)
-  "Returns whether LIST consists only of arbitrarily nested empty lists."
-  (cond ((not (listp list)) nil)
-	((null list) t)
-	(t (every #'recursively-empty-p list))))
+(declaim (inline memq))
+(defun memq (item list)
+  (member item list :test #'eq))
+
+(defun remove-from-tree-if (predicate tree)
+  (cond ((atom tree) tree)
+        ((funcall predicate (car tree))
+         (remove-from-tree-if predicate (cdr tree)))
+        (t
+         (cons (remove-from-tree-if predicate (car tree)) 
+               (remove-from-tree-if predicate (cdr tree))))))
+
+(defun remove-from-tree (item tree)
+  (remove-from-tree-if #'(lambda (x) (eql x item)) tree))
 
 (defun maybecall (bool fn &rest args)
   "Call FN with ARGS if BOOL is T. Otherwise return ARGS as multiple values."
@@ -57,265 +69,40 @@
       (macro-function symbol)
       (special-operator-p symbol)
       (eq symbol 'declare)))
-  
+
 (defun valid-operator-name-p (string)
   "Is STRING the name of a function, macro, or special-operator?"
   (let ((symbol (parse-symbol string)))
     (valid-operator-symbol-p symbol)))
 
 (defun valid-function-name-p (form)
-  (or (symbolp form)
-      (and (consp form)
-           (second form)
-           (not (third form))
-           (eq (first form) 'setf)
-           (symbolp (second form)))))
-
-;;; A ``raw form spec'' can be either: 
-;;; 
-;;;   i)   a list of strings representing a Common Lisp form
-;;; 
-;;;   ii)  a list of strings as of i), but which additionally 
-;;;        contains other raw form specs
-;;; 
-;;;   iii) one of:
-;;; 
-;;;      a)  (:declaration declspec) 
-;;; 
-;;;            where DECLSPEC is a raw form spec.
-;;; 
-;;;      b)  (:type-specifier typespec) 
-;;;        
-;;;            where TYPESPEC is a raw form spec.
-;;; 
-;;; 
-;;; A ``form spec'' is either
-;;; 
-;;;   1) a normal Common Lisp form
-;;; 
-;;;   2) a Common Lisp form with a list as its CAR specifying what namespace
-;;;      the operator is supposed to be interpreted in:
-;;; 
-;;;        a) ((:declaration decl-identifier) declarg1 declarg2 ...)
-;;; 
-;;;        b) ((:type-specifier typespec-op) typespec-arg1 typespec-arg2 ...)
-;;; 
-;;; 
-;;; Examples:
-;;; 
-;;;   ("defmethod")                       =>  (defmethod)
-;;;   ("cl:defmethod")                    =>  (cl:defmethod)
-;;;   ("defmethod" "print-object\)        =>  (defmethod print-object)
-;;; 
-;;;   ("foo" ("bar" ("quux")) "baz")      =>  (foo (bar (quux)) baz)
-;;; 
-;;;   (:declaration ("optimize"))         =>  ((:declaration optimize))
-;;;   (:declaration ("type" "string"))    =>  ((:declaration type) string)
-;;;   (:type-specifier ("float"))         =>  ((:type-specifier float))
-;;;   (:type-specifier ("float" 0 100))   =>  ((:type-specifier float) 0 100)
-;;;
-
-(defslimefun arglist-for-echo-area (raw-specs &key arg-indices
-                                              print-right-margin print-lines)
-  "Return the arglist for the first valid ``form spec'' in
-RAW-SPECS. A ``form spec'' is a superset of functions, macros,
-special-ops, declarations and type specifiers."
-  (handler-case 
-      (with-buffer-syntax ()
-        (multiple-value-bind (form-spec position newly-interned-symbols)
-            (parse-first-valid-form-spec raw-specs #'read-conversatively-for-autodoc)
-          (when form-spec
-            (unwind-protect
-                 (let ((arglist (arglist-from-form-spec form-spec :remove-args nil)))
-                   (unless (eq arglist :not-available)
-                     (multiple-value-bind (type operator)
-                         (split-form-spec form-spec)
-                       (let* ((index (nth position arg-indices))
-                              (stringified-arglist
-                               (decoded-arglist-to-string
-                                arglist
-                                :operator operator
-                                :print-right-margin print-right-margin
-                                :print-lines print-lines
-                                ;; Do not highlight the operator:
-                                :highlight (and index (not (zerop index)) index))))
-                         ;; Post formatting:
-                         (case type
-                           (:type-specifier (format nil "[Typespec] ~A" stringified-arglist))
-                           (:declaration
-                            (locally (declare (special *arglist-pprint-bindings*))
-                              (with-bindings *arglist-pprint-bindings*
-                                ;; Try to print ``(declare (declspec))'' (or ``declaim'' etc.)
-                                (let ((op (%find-declaration-operator raw-specs position)))
-                                  (if op
-                                      (format nil "(~A ~A)" op stringified-arglist)
-                                      (format nil "[Declaration] ~A" stringified-arglist))))))
-                           (t stringified-arglist))))))
-              (mapc #'unintern-in-home-package newly-interned-symbols)))))
-    (error (condition)
-      (format nil "ARGLIST (error): ~A" condition))
-    ))
-
-(defun %find-declaration-operator (raw-specs position)
-  (let ((op-rawspec (nth (1+ position) raw-specs)))
-    (first (parse-form-spec op-rawspec #'read-conversatively-for-autodoc))))
-
-;; This is a wrapper object around anything that came from Slime and
-;; could not reliably be read. 
-(defstruct (arglist-dummy
-	     (:conc-name #:arglist-dummy.))
-  string-representation)
+  (and (match form
+         ((#'symbolp _)         t)
+         (('setf (#'symbolp _)) t)
+         (_                     nil))
+       (fboundp form)
+       t))
 
-(defun read-conversatively-for-autodoc (string)
-  "Tries to find the symbol that's represented by STRING. 
 
-If it can't, this either means that STRING does not represent a
-symbol, or that the symbol behind STRING would have to be freshly
-interned. Because this function is supposed to be called from the
-automatic arglist display stuff from Slime, interning freshly
-symbols is a big no-no.
-
-In such a case (that no symbol could be found), an object of type
-ARGLIST-DUMMY is returned instead, which works as a placeholder
-datum for subsequent logics to rely on."
-  (let* ((string  (string-left-trim '(#\Space #\Tab #\Newline) string))
-         (length  (length string))
-	 (prefix  (cond ((eql (aref string 0) #\') :quote)
-                        ((search "#'" string :end2 (min length 2)) :sharpquote)
-                        (t nil))))
-    (multiple-value-bind (symbol found?)
-	(parse-symbol (case prefix
-                        (:quote      (subseq string 1))
-                        (:sharpquote (subseq string 2))
-                        (t string)))
-      (if found?
-          (case prefix
-            (:quote      `(quote ,symbol))
-            (:sharpquote `(function ,symbol))
-            (t symbol))
-	  (make-arglist-dummy :string-representation string)))))
+(defmacro multiple-value-or (&rest forms)
+  (if (null forms)
+      nil
+      (let ((first (first forms))
+            (rest (rest forms)))
+        `(let* ((values (multiple-value-list ,first))
+                (primary-value (first values)))
+          (if primary-value
+              (values-list values)
+              (multiple-value-or , at rest))))))
 
+(defmacro with-available-arglist ((var &rest more-vars) form &body body)
+  `(multiple-value-bind (,var , at more-vars) ,form
+     (if (eql ,var :not-available)
+         :not-available
+         (progn #+ignore (assert (arglist-p ,var)) , at body))))
 
-(defun parse-form-spec (raw-spec &optional reader)
-  "Takes a raw (i.e. unparsed) form spec from SLIME and returns a
-proper form spec for further processing within SWANK. Returns NIL
-if RAW-SPEC could not be parsed. Symbols that had to be interned
-in course of the conversion, are returned as secondary return value."
-  (flet ((parse-extended-spec (raw-extension extension-flag)
-           (when (and (stringp (first raw-extension)) ; (:DECLARATION (("a" "b" ("c")) "d"))
-                      (nth-value 1 (parse-symbol (first raw-extension))))
-	     (multiple-value-bind (extension introduced-symbols)
-                 (read-form-spec raw-extension reader)
-	       (unless (recursively-empty-p extension) ; (:DECLARATION (())) &c.
-                 (destructuring-bind (identifier &rest args) extension
-                   (values `((,extension-flag ,identifier) , at args)
-                           introduced-symbols)))))))
-    (when (consp raw-spec)
-      (destructure-case raw-spec
-        ((:declaration raw-declspec)
-         (parse-extended-spec raw-declspec :declaration))
-        ((:type-specifier raw-typespec)
-         (parse-extended-spec raw-typespec :type-specifier))
-        (t
-         (when (every #'(lambda (x) (or (stringp x) (consp x))) raw-spec)
-           (destructuring-bind (raw-operator &rest raw-args) raw-spec
-             (multiple-value-bind (operator found?) (parse-symbol raw-operator)
-               (when (and found? (valid-operator-symbol-p operator))
-                 (multiple-value-bind (parsed-args introduced-symbols)
-                     (read-form-spec raw-args reader)
-                   (values `(,operator , at parsed-args) introduced-symbols)))))))))))
-
-
-(defun split-form-spec (spec)
-  "Returns all three relevant information a ``form spec''
-contains: the operator type, the operator, and the operands."
-  (destructuring-bind (operator-designator &rest arguments) spec
-    (multiple-value-bind (type operator)
-        (if (listp operator-designator)
-            (values (first operator-designator) (second operator-designator))
-            (values :function operator-designator)) ; functions, macros, special ops
-      (values type operator arguments))))           ;  are all fbound.
-
-(defun parse-first-valid-form-spec (raw-specs &optional reader)
-  "Returns the first parsed form spec in RAW-SPECS that can
-successfully be parsed. Additionally returns that spec's position
-as secondary, and all newly interned symbols as tertiary return
-value."
-  (loop for raw-spec in raw-specs
-	for pos upfrom 0
-	do (multiple-value-bind (spec symbols) (parse-form-spec raw-spec reader)
-	     (when spec (return (values spec pos symbols))))))
-
-(defun read-form-spec (spec &optional reader)
-  "Turns the ``raw form spec'' SPEC into a proper Common Lisp
-form. As secondary return value, it returns all the symbols that
-had to be newly interned during the conversion.
-
-READER is a function that takes a string, and returns two values:
-the Common Lisp datum that the string represents, a flag whether
-the returned datum is a symbol and has been newly interned in
-some package.
-
-If READER is not explicitly given, the function 
-READ-SOFTLY-FROM-STRING* is used instead."
-  (when spec
-    (with-buffer-syntax ()
-      (call-with-ignored-reader-errors
-       #'(lambda ()
-           (let ((result) (newly-interned-symbols) (ok))
-             (unwind-protect
-                  (dolist (element spec (setq ok t))
-                    (etypecase element
-                      (string
-                       (multiple-value-bind (sexp newly-interned?)
-                           (funcall (or reader 'read-softly-from-string*) element)
-                         (push sexp result)
-                         (when newly-interned?
-                           (push sexp newly-interned-symbols))))
-                      (list
-                       (multiple-value-bind (read-spec interned-symbols)
-                           (read-form-spec element reader)
-                         (push read-spec result)
-                         (setf newly-interned-symbols
-                               (append interned-symbols
-                                       newly-interned-symbols))))))
-               (unless ok
-                 (mapc #'unintern-in-home-package newly-interned-symbols)))
-             (values (nreverse result)
-                     (nreverse newly-interned-symbols))))))))
-
-(defun read-softly-from-string* (string)
-  "Like READ-SOFTLY-FROM-STRING, but only returns the sexp and
-the flag if a symbol had to be interned."
-  (multiple-value-bind (sexp pos interned?)
-      (read-softly-from-string string)
-    ;; To make sure that we haven't got any junk from Emacs.
-    (assert (= pos (length string)))
-    (values sexp interned?)))
-
-(defun read-softly-from-string (string)
-  "Returns three values:
-
-     1. the object resulting from READing STRING.
-
-     2. The index of the first character in STRING that was not read.
-
-     3. T if the object is a symbol that had to be newly interned
-        in some package. (This does not work for symbols in
-        compound forms like lists or vectors.)"
-  (multiple-value-bind (symbol found? symbol-name package) (parse-symbol string)
-    (if found?
-        (values symbol (length string) nil)
-        (multiple-value-bind (sexp pos) (read-from-string string)
-          (values sexp pos
-                  (when (symbolp sexp)
-                    (prog1 t
-                      ;; assert that PARSE-SYMBOL didn't parse incorrectly.
-                      (assert (and (equal symbol-name (symbol-name sexp))
-                                   (eq package (symbol-package sexp)))))))))))
 
-(defun unintern-in-home-package (symbol)
-  (unintern symbol (symbol-package symbol)))
+;;;; Arglist Definition
 
 (defstruct (arglist (:conc-name arglist.) (:predicate arglist-p))
   provided-args         ; list of the provided actual arguments
@@ -335,7 +122,7 @@
 ;;;
 ;;; [*] The &ANY lambda keyword is an extension to ANSI Common Lisp,
 ;;;     and is only used to describe certain arglists that cannot be
-;;;     described in another way. 
+;;;     described in another way.
 ;;;
 ;;;     &ANY is very similiar to &KEY but while &KEY is based upon
 ;;;     the idea of a plist (key1 value1 key2 value2), &ANY is a
@@ -364,95 +151,214 @@
 ;;;       (DECLARE (OPTIMIZE &ANY (compilation-speed 1) (safety 1) ...))
 ;;;
 
-;; FIXME: This really ought to be rewritten.
-(defun print-arglist (arglist &key operator highlight)
-  (let ((index 0)
-        (need-space nil))
-    (labels ((print-arg (arg)
-               (typecase arg
-                 (arglist               ; destructuring pattern
-                  (print-arglist arg))
-                 (optional-arg
-		  (let ((enc-arg (encode-optional-arg arg)))
-		    (if (symbolp enc-arg)
-			(princ enc-arg)
-			(destructuring-bind (var &optional (initform nil initform-p)) enc-arg
-			    (pprint-logical-block (nil nil :prefix "(" :suffix ")")
-			      (format t "~A~:[~; ~S~]" var initform-p initform))))))
-                 (keyword-arg
-                  (let ((enc-arg (encode-keyword-arg arg)))
-                    (etypecase enc-arg
-                      (symbol (princ enc-arg))
-                      ((cons symbol)
-		       (destructuring-bind (keyarg initform) enc-arg
-			 (pprint-logical-block (nil nil :prefix "(" :suffix ")")
-			   (format t "~A ~S" keyarg initform))))
-                      ((cons cons)
-		       (destructuring-bind ((keyword-name var) &optional (initform nil initform-p))
-			   enc-arg
-			 (pprint-logical-block (nil nil :prefix "(" :suffix ")")
-			   (pprint-logical-block (nil nil :prefix "(" :suffix ")")
-			     (format t "~S ~A" keyword-name var))
-			   (when initform-p
-			     (format t " ~S" initform))))))))
-                 (t           ; required formal or provided actual arg
-                  (if (keywordp arg)
-		      (prin1 arg)	; for &ANY args.
-		      (princ arg)))))
-             (print-space ()
-               (ecase need-space
-                 ((nil))
-                 ((:miser)
-                  (write-char #\space)

[1496 lines skipped]




From trittweiler at common-lisp.net  Sat Oct 31 22:41:04 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 31 Oct 2009 18:41:04 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1N4Md6-0004Hc-1Q@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
	* slime.el (slime-bug): Deleted.

	* slime-fontifying-fu.el (slime-search-suppressed-forms-internal):
	Wrap form in `ignore-errors' again. People have been guinea pigs
	long enough. Suppression of reader-conditionalized forms seems to
	work pretty reliably now.


--- /project/slime/cvsroot/slime/ChangeLog	2009/10/31 22:13:54	1.1902
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/31 22:41:03	1.1903
@@ -1,5 +1,9 @@
 2009-10-31  Tobias C. Rittweiler <tcr at freebits.de>
 
+	* slime.el (slime-bug): Deleted.
+
+2009-10-31  Tobias C. Rittweiler <tcr at freebits.de>
+
 	* slime.el (slime-inside-string-p, slime-inside-comment-p)
 	(slime-inside-string-or-comment-p): New.
 
--- /project/slime/cvsroot/slime/slime.el	2009/10/31 22:13:54	1.1244
+++ /project/slime/cvsroot/slime/slime.el	2009/10/31 22:41:03	1.1245
@@ -732,27 +732,6 @@
                            (or (position ?\n string) most-positive-fixnum)
                            (1- (frame-width)))))
 
-(defun slime-bug (message &rest args)
-  (slime-display-warning 
-"%S:%d:%d (pt=%d).
-%s
-
-This is a bug in Slime itself. Please report this to the
-mailinglist slime-devel at common-lisp.net and include your Emacs
-version, the guilty Lisp source file, the header of this
-message, and the following backtrace.
-
-Backtrace:
-%s
---------------------------------------------------------------
-"
-   (buffer-name)
-   (line-number-at-pos)
-   (current-column)
-   (point)
-   (apply #'format message args)
-   (with-output-to-string (backtrace))))
-
 ;; Interface
 (defun slime-set-truncate-lines ()
   "Apply `slime-truncate-lines' to the current buffer."




From trittweiler at common-lisp.net  Sat Oct 31 22:41:04 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 31 Oct 2009 18:41:04 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1N4Md6-0004Hv-CD@common-lisp.net>

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

Modified Files:
	ChangeLog slime-fontifying-fu.el 
Log Message:
	* slime.el (slime-bug): Deleted.

	* slime-fontifying-fu.el (slime-search-suppressed-forms-internal):
	Wrap form in `ignore-errors' again. People have been guinea pigs
	long enough. Suppression of reader-conditionalized forms seems to
	work pretty reliably now.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/31 22:13:55	1.266
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/31 22:41:04	1.267
@@ -1,5 +1,12 @@
 2009-10-31  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* slime-fontifying-fu.el (slime-search-suppressed-forms-internal):
+	Wrap form in `ignore-errors' again. People have been guinea pigs
+	long enough. Suppression of reader-conditionalized forms seems to
+	work pretty reliably now.
+
+2009-10-31  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* slime-autodoc.el, swank-arglists.lisp: Large parts were
 	rewritten. Autodoc is now able to highlight &key parameters, and
 	parameters in nested arglists.
--- /project/slime/cvsroot/slime/contrib/slime-fontifying-fu.el	2009/10/10 07:58:20	1.15
+++ /project/slime/cvsroot/slime/contrib/slime-fontifying-fu.el	2009/10/31 22:41:04	1.16
@@ -43,16 +43,14 @@
           (when (<= (point) limit)
             (if (or (and (eq char ?+) (not val))
                     (and (eq char ?-) val))
-                (progn
+                ;; If `slime-extend-region-for-font-lock' did not
+                ;; fully extend the region, the assertion below may
+                ;; fail. This should only happen on XEmacs and older
+                ;; versions of GNU Emacs.
+                (ignore-errors
                   (forward-sexp) (backward-sexp)
                   ;; Try to suppress as far as possible.
-                  (ignore-errors (slime-forward-sexp))
-                  ;; There was an `ignore-errors' form around all this
-                  ;; because the following assertion was triggered
-                  ;; regularly (resulting in the "non-deterministic"
-                  ;; behaviour mentioned in the comment further below.)
-                  ;; With extending the region properly, this assertion
-                  ;; would truly mean a bug now.
+                  (slime-forward-sexp)
                   (assert (<= (point) limit))
                   (let ((md (match-data nil slime-search-suppressed-forms-match-data)))
                     (setf (first md) start)
@@ -84,10 +82,7 @@
            (setq result 'retry)) 
           (error
            (setq result nil)
-           ;; If this reports `(cl-assertion-failed (<= (point) limit))',
-           ;; the actual culprit is `slime-extend-region-for-font-lock'
-           ;; which did not extend the region enough in this case.
-           (slime-bug 
+           (slime-display-warning
             (concat "Caught error during fontification while searching for forms\n"
                     "that are suppressed by reader-conditionals. The error was: %S.")
             condition))))
@@ -141,7 +136,7 @@
             (slime-compute-region-for-font-lock font-lock-beg font-lock-end))
           changedp)
       (error
-       (slime-bug 
+       (slime-display-warning
         (concat "Caught error when trying to extend the region for fontification.\n"
                 "The error was: %S\n"
                 "Further: font-lock-beg=%d, font-lock-end=%d.")