From trittweiler at common-lisp.net  Sun Aug  2 12:57:23 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sun, 02 Aug 2009 08:57:23 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MXact-0000cs-I8@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank-backend.lisp swank-sbcl.lisp 
Log Message:
	* swank-backend.lisp (severity [type]): Allow :redefinition.

	* swank-sbcl.lisp (signal-compiler-condition): Tag redefinitions.

	* slime.el (slime-maybe-show-compilation-log): Do not show
	compilation log if each note describes just a redefinition.
	(slime-insert-compilation-log): Insert notes indented by 2
	spaces. Insert some more newlines so the buffer appears more
	structured.
	(slime-show-note-counts): Add :redefinition to ecase.
	(slime-redefinition-note-p): New.
	(slime-severity-label): Was unused. Adapted to be usable.


--- /project/slime/cvsroot/slime/ChangeLog	2009/07/30 23:27:05	1.1821
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/02 12:57:23	1.1822
@@ -1,3 +1,18 @@
+2009-08-02  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-backend.lisp (severity [type]): Allow :redefinition.
+
+	* swank-sbcl.lisp (signal-compiler-condition): Tag redefinitions.
+
+	* slime.el (slime-maybe-show-compilation-log): Do not show
+	compilation log if each note describes just a redefinition.
+	(slime-insert-compilation-log): Insert notes indented by 2
+	spaces. Insert some more newlines so the buffer appears more
+	structured.
+	(slime-show-note-counts): Add :redefinition to ecase.
+	(slime-redefinition-note-p): New.
+	(slime-severity-label): Was unused. Adapted to be usable.
+
 2009-07-30  Stas Boukarev  <stassats at gmail.com>
 
 	* doc/slime.texi (Setting up pathname translations): add that it is
--- /project/slime/cvsroot/slime/slime.el	2009/07/26 10:18:29	1.1202
+++ /project/slime/cvsroot/slime/slime.el	2009/08/02 12:57:23	1.1203
@@ -2774,10 +2774,10 @@
   (let ((nerrors 0) (nwarnings 0) (nstyle-warnings 0) (nnotes 0))
     (dolist (note notes)
       (ecase (slime-note.severity note)
-	((:error :read-error) (incf nerrors))
-        (:warning             (incf nwarnings))
-        (:style-warning       (incf nstyle-warnings))
-        (:note                (incf nnotes))))
+	((:error :read-error)           (incf nerrors))
+        ((:warning)                     (incf nwarnings))
+        ((:redefinition :style-warning) (incf nstyle-warnings))
+        ((:note)                        (incf nnotes))))
     (message "%s:%s%s%s%s%s"
              (if successp 
                  "Compilation finished" 
@@ -2934,6 +2934,9 @@
 (defun slime-note-has-location-p (note)
   (not (eq ':error (car (slime-note.location note)))))
 
+(defun slime-redefinition-note-p (note)
+  (eq (slime-note.severity note) :redefinition))
+
 (defun slime-create-compilation-log (notes)
   "Create a buffer for `next-error' to use."
   (with-current-buffer (get-buffer-create "*SLIME Compilation*")
@@ -2945,7 +2948,8 @@
   "Display the log on failed compilations or if NOTES is non-nil."
   (with-struct (slime-compilation-result. notes duration successp)
       slime-last-compilation-result
-    (when (or notes (not successp))
+    (when (or (and notes (not (every #'slime-redefinition-note-p notes)))
+              (not successp))
       (slime-with-popup-buffer ("*SLIME Compilation*")
         (slime-insert-compilation-log notes)
         (let ((inhibit-read-only t))
@@ -2968,11 +2972,12 @@
       (insert (format "cd %s\n%d compiler notes:\n" 
                       default-directory (length notes)))
       (dolist (note notes)
-        (insert (format "%s%s:\n%s\n"
+        (insert (format "\n%s%s:\n"
                         (slime-compilation-loc (slime-note.location note))
-                        (substring (symbol-name (slime-note.severity note))
-                                   1)
-                        (slime-note.message note)))))
+                        (slime-severity-label (slime-note.severity note))))
+        (slime-with-rigid-indentation 2
+          (insert (slime-note.message note))
+          (insert "\n"))))
     (setq next-error-last-buffer (current-buffer))))
 
 (defun slime-compilation-loc (location)
@@ -3018,12 +3023,7 @@
   (plist-get note :location))
 
 (defun slime-severity-label (severity)
-  (ecase severity
-    (:note "Notes")
-    (:warning "Warnings")
-    (:error "Errors")
-    (:read-error "Read Errors")
-    (:style-warning "Style Warnings")))
+  (subseq (symbol-name severity) 1))
 
 
 ;;;;; Adding a single compiler note
--- /project/slime/cvsroot/slime/swank-backend.lisp	2009/07/11 18:25:15	1.178
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2009/08/02 12:57:23	1.179
@@ -13,8 +13,8 @@
 (defpackage :swank-backend
   (:use :common-lisp)
   (:export #:sldb-condition
-           #:original-condition
            #:compiler-condition
+           #:original-condition
            #:message
            #:short-message
            #:condition
@@ -410,7 +410,7 @@
 like `compile-file'")
 
 (deftype severity () 
-  '(member :error :read-error :warning :style-warning :note))
+  '(member :error :read-error :warning :style-warning :note :redefinition))
 
 ;; Base condition type for compiler errors, warnings and notes.
 (define-condition compiler-condition (condition)
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/07/26 10:18:17	1.245
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/08/02 12:57:23	1.246
@@ -1,4 +1,4 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
 ;;;
 ;;; swank-sbcl.lisp --- SLIME backend for SBCL.
 ;;;
@@ -407,6 +407,7 @@
       (sb-introspect:deftype-lambda-list typespec-operator)
     (if foundp arglist (call-next-method))))
 
+
 (defvar *buffer-name* nil)
 (defvar *buffer-offset*)
 (defvar *buffer-substring* nil)
@@ -435,6 +436,8 @@
            :severity (etypecase condition
                        (sb-c:compiler-error  :error)
                        (sb-ext:compiler-note :note)
+                       (sb-kernel:redefinition-warning
+                                             :redefinition)
                        (style-warning        :style-warning)
                        (warning              :warning)
                        (reader-error         :read-error)




From sboukarev at common-lisp.net  Tue Aug  4 23:54:56 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Tue, 04 Aug 2009 19:54:56 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MYTqK-0000iJ-1L@common-lisp.net>

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
* swank-sbcl.lisp (signal-compiler-condition): read
sb-kernel:redefinition-warning only if it exists.
Some older SBCLs don't have it (particularly included in the
stable Debian).


--- /project/slime/cvsroot/slime/ChangeLog	2009/08/02 12:57:23	1.1822
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/04 23:54:55	1.1823
@@ -1,3 +1,10 @@
+2009-08-04  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-sbcl.lisp (signal-compiler-condition): read
+	sb-kernel:redefinition-warning only if it exists.
+	Some older SBCLs don't have it (particularly included in the
+	stable Debian).
+
 2009-08-02  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-backend.lisp (severity [type]): Allow :redefinition.
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/08/02 12:57:23	1.246
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/08/04 23:54:55	1.247
@@ -436,6 +436,7 @@
            :severity (etypecase condition
                        (sb-c:compiler-error  :error)
                        (sb-ext:compiler-note :note)
+                       #+#.(swank-backend::with-symbol redefinition-warning sb-kernel)
                        (sb-kernel:redefinition-warning
                                              :redefinition)
                        (style-warning        :style-warning)




From sboukarev at common-lisp.net  Wed Aug  5 17:15:35 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 05 Aug 2009 13:15:35 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MYk5P-0000wC-9J@common-lisp.net>

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

Modified Files:
	ChangeLog swank-fancy-inspector.lisp 
Log Message:
* swank-fancy-inspector.lisp (emacs-inspect): add buttons for removing
compiler-macros and unbinding variables.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/07/22 11:25:28	1.229
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/05 17:15:35	1.230
@@ -1,3 +1,8 @@
+2009-08-05  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-fancy-inspector.lisp (emacs-inspect): add buttons for removing
+	 compiler-macros and unbinding variables.
+
 2009-07-22  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-fuzzy.lisp (fuzzy-convert-matching-for-emacs): format
--- /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp	2009/05/14 18:13:21	1.21
+++ /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp	2009/08/05 17:15:35	1.22
@@ -16,10 +16,16 @@
 	;;
 	;; Value 
 	(cond ((boundp symbol)
-               (label-value-line (if (constantp symbol)
-                                     "It is a constant of value"
-                                     "It is a global variable bound to")
-                                 (symbol-value symbol)))
+               (append
+                (label-value-line (if (constantp symbol)
+                                      "It is a constant of value"
+                                      "It is a global variable bound to")
+                                  (symbol-value symbol) :newline nil)
+                ;; unbinding constants might be not a good idea, but
+                ;; implementations usually provide a restart.
+                `(" " (:action "[unbind it]"
+                               ,(lambda () (makunbound symbol))))
+                '((:newline))))
 	      (t '("It is unbound." (:newline))))
 	(docstring-ispec "Documentation" symbol 'variable)
 	(multiple-value-bind (expansion definedp) (macroexpand symbol)
@@ -34,14 +40,20 @@
 			  (:value ,(macro-function symbol)))
 			`("It is a function: " 
 			  (:value ,(symbol-function symbol))))
-		    `(" " (:action "[make funbound]"
+		    `(" " (:action "[unbind it]"
 				   ,(lambda () (fmakunbound symbol))))
 		    `((:newline)))
 	    `("It has no function value." (:newline)))
 	(docstring-ispec "Function Documentation" symbol 'function)
-	(if (compiler-macro-function symbol)
-	    (label-value-line "It also names the compiler macro"
-			      (compiler-macro-function symbol)))
+	(when (compiler-macro-function symbol)
+          
+	    (append
+             (label-value-line "It also names the compiler macro"
+                               (compiler-macro-function symbol) :newline nil)
+             `(" " (:action "[remove it]"
+                            ,(lambda ()
+                                     (setf (compiler-macro-function symbol) nil)))
+                   (:newline))))
 	(docstring-ispec "Compiler Macro Documentation" 
 			 symbol 'compiler-macro)
 	;;




From trittweiler at common-lisp.net  Sat Aug  8 21:45:12 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 08 Aug 2009 17:45:12 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MZtiy-0000yS-0W@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
	M-n / M-p in a .lisp buffer now also jump to the respective note
	in the compilation-log buffer if one is currently displayed to the
	user.

	* slime.el (slime-remove-old-overlays): Simplified.
	(slime-insert-compilation-log): Add a note-overlay for each note
	so we can find the right one when user uses M-n/M-p in .lisp
	buffer.
	(slime-goto-note-in-compilation-log): New.
	(slime-make-note-overlay): Extracted from
	`slime-create-note-overlay'.
	(slime-next-note, slime-previous-note): Simplified.
	(slime-show-note): Goto note in compilation-log if available.
	(slime-note-overlay-p): Call overlay property `slime-note', not
	just `slime'.
	(slime-find-note): Likewise; also returns the overlay if found.
	(slime-show-buffer-position): Optionally recenter position to the
	top of the window.


--- /project/slime/cvsroot/slime/ChangeLog	2009/08/04 23:54:55	1.1823
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/08 21:45:11	1.1824
@@ -1,3 +1,24 @@
+2009-08-08  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	M-n / M-p in a .lisp buffer now also jump to the respective note
+	in the compilation-log buffer if one is currently displayed to the
+	user.
+
+	* slime.el (slime-remove-old-overlays): Simplified.
+	(slime-insert-compilation-log): Add a note-overlay for each note
+	so we can find the right one when user uses M-n/M-p in .lisp
+	buffer.
+	(slime-goto-note-in-compilation-log): New.
+	(slime-make-note-overlay): Extracted from
+	`slime-create-note-overlay'.
+	(slime-next-note, slime-previous-note): Simplified.
+	(slime-show-note): Goto note in compilation-log if available.
+	(slime-note-overlay-p): Call overlay property `slime-note', not
+	just `slime'.
+	(slime-find-note): Likewise; also returns the overlay if found.
+	(slime-show-buffer-position): Optionally recenter position to the
+	top of the window.
+
 2009-08-04  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-sbcl.lisp (signal-compiler-condition): read
--- /project/slime/cvsroot/slime/slime.el	2009/08/02 12:57:23	1.1203
+++ /project/slime/cvsroot/slime/slime.el	2009/08/08 21:45:11	1.1204
@@ -2812,11 +2812,9 @@
         (save-restriction
           (widen)                ; remove overlays within the whole buffer.
           (goto-char (point-min))
-          (while (not (eobp))
-            (dolist (o (overlays-at (point)))
-              (when (overlay-get o 'slime)
-                (delete-overlay o)))
-            (goto-char (next-overlay-change (point)))))))))
+          (let ((o))
+            (while (setq o (slime-find-next-note))
+              (delete-overlay o))))))))
 
 (defun slime-filter-buffers (predicate)
   "Return a list of where PREDICATE returns true.
@@ -2972,12 +2970,14 @@
       (insert (format "cd %s\n%d compiler notes:\n" 
                       default-directory (length notes)))
       (dolist (note notes)
-        (insert (format "\n%s%s:\n"
-                        (slime-compilation-loc (slime-note.location note))
-                        (slime-severity-label (slime-note.severity note))))
-        (slime-with-rigid-indentation 2
-          (insert (slime-note.message note))
-          (insert "\n"))))
+        (let ((start (1+ (point))))     ; 1+ due to \n
+          (insert (format "\n%s%s:\n"
+                          (slime-compilation-loc (slime-note.location note))
+                          (slime-severity-label (slime-note.severity note))))
+          (slime-with-rigid-indentation 2
+            (insert (slime-note.message note))
+            (insert "\n"))
+          (slime-make-note-overlay note start (point)))))
     (setq next-error-last-buffer (current-buffer))))
 
 (defun slime-compilation-loc (location)
@@ -2993,6 +2993,23 @@
            (format "%s:%d:%d: " (or filename "") line col)))
         (t "")))
 
+(defun slime-goto-note-in-compilation-log (note)
+  "Try to find `note' in the compilation log, and display it to
+the user if it's there."
+  (with-current-buffer (get-buffer "*SLIME Compilation*")
+    (let ((origin (point))
+          (foundp nil))
+      (goto-char (point-min))
+      (let ((overlay))
+        (while (and (setq overlay (slime-find-next-note))
+                    (not foundp))
+          (let ((other-note (overlay-get overlay 'slime-note)))
+            (when (slime-notes-in-same-location-p note other-note)
+              (slime-show-buffer-position (overlay-start overlay) 'top)
+              (setq foundp t)))))
+      (unless foundp
+        (goto-char origin)))))
+
 (defun slime-alistify (list key test)
   "Partition the elements of LIST into an alist.
 KEY extracts the key from an element and TEST is used to compare
@@ -3043,6 +3060,11 @@
             (slime-merge-note-into-overlay overlay severity message)
             (slime-create-note-overlay note start end severity message))))))
 
+(defun slime-make-note-overlay (note start end)
+  (let ((overlay (make-overlay start end)))
+    (overlay-put overlay 'slime-note note)
+    overlay))
+
 (defun slime-create-note-overlay (note start end severity message)
   "Create an overlay representing a compiler note.
 The overlay has several properties:
@@ -3052,9 +3074,8 @@
   HELP-ECHO  - a string describing the note, both for future reference
                and for display as a tooltip (due to the special
                property name)."
-  (let ((overlay (make-overlay start end)))
+  (let ((overlay (slime-make-note-overlay note start end)))
     (flet ((putp (name value) (overlay-put overlay name value)))
-      (putp 'slime note)
       (putp 'face (slime-severity-face severity))
       (putp 'severity severity)
       (putp 'mouse-face 'highlight)
@@ -3534,10 +3555,10 @@
 (defun slime-next-note ()
   "Go to and describe the next compiler note in the buffer."
   (interactive)
-  (let ((here (point)))
-    (slime-find-next-note)
-    (if (slime-note-at-point)
-        (slime-show-note (slime-note-at-point))
+  (let ((here (point))
+        (note (slime-find-next-note)))
+    (if note
+        (slime-show-note note)
         (progn
           (goto-char here)
           (message "No next note.")))))
@@ -3545,10 +3566,10 @@
 (defun slime-previous-note ()
   "Go to and describe the previous compiler note in the buffer."
   (interactive)
-  (let ((here (point)))
-    (slime-find-previous-note)
-    (if (slime-note-at-point)
-        (slime-show-note (slime-note-at-point))
+  (let ((here (point))
+        (note (slime-find-previous-note)))
+    (if note
+        (slime-show-note note)
         (progn
           (goto-char here)
           (message "No previous note.")))))
@@ -3569,6 +3590,8 @@
 (defun slime-show-note (overlay)
   "Present the details of a compiler note to the user."
   (slime-temporarily-highlight-note overlay)
+  (when (get-buffer-window "*SLIME Compilation*" t)
+    (slime-goto-note-in-compilation-log (overlay-get overlay 'slime-note)))
   (let ((message (get-char-property (point) 'help-echo)))
     (slime-message "%s" (if (zerop (length message)) "\"\"" message))))
 
@@ -3595,7 +3618,7 @@
 
 (defun slime-note-overlay-p (overlay)
   "Return true if OVERLAY represents a compiler note."
-  (overlay-get overlay 'slime))
+  (overlay-get overlay 'slime-note))
 
 (defun slime-note-overlays-at-point ()
   "Return a list of all note overlays that are under the point."
@@ -3603,24 +3626,28 @@
 
 (defun slime-find-next-note ()
   "Go to the next position with the `slime-note' text property.
-Retuns true if such a position is found."
+Retuns the note overlay if such a position is found, otherwise nil."
   (slime-find-note 'next-single-char-property-change))
 
 (defun slime-find-previous-note ()
   "Go to the next position with the `slime' text property.
-Returns true if such a position is found."
+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."
-  (let ((origin (point)))
-    (loop do (goto-char (funcall next-candidate-fn (point) 'slime))
-	  until (or (slime-note-at-point)
-		    (eobp)
-		    (bobp)))
-    (unless (slime-note-at-point)
-      (goto-char origin))))
+NEXT-CANDIDATE-FN is called to find each new position for consideration.
+Retuns 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)))
+    (if overlay
+        overlay
+        (prog1 nil (goto-char origin)))))
 
 
 ;;;; Arglist Display
@@ -5672,14 +5699,16 @@
 
 ;; FIXME: these functions need factorization
 
-(defun slime-show-buffer-position (position)
+(defun slime-show-buffer-position (position &optional recenter)
   "Ensure sure that the POSITION in the current buffer is visible."
-  (let ((window (display-buffer (current-buffer) t)))
+  (let ((window (display-buffer (current-buffer) t t)))
     (save-selected-window
       (select-window window)
       (goto-char position)
       (unless (pos-visible-in-window-p)
-        (reposition-window)))))
+        (reposition-window))
+      (cond ((eq recenter 'top)    (recenter 0))
+            ((eq recenter 'center) (recenter))))))
 
 (defun sldb-recenter-region (start end &optional center)
   "Make the region from START to END visible.




From sboukarev at common-lisp.net  Sun Aug  9 14:07:47 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sun, 09 Aug 2009 10:07:47 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1Ma93r-0004sw-OG@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
* slime.el (slime-profile-by-substring): new function for profiling
functions by matching a substring.

* swank.lisp (profile-by-substring): ditto.

* contrib/slime-fuzzy.el (slime-fuzzy-complete-symbol): change
`comint-completion-addsuffix' to not add space after completing
a filename.


--- /project/slime/cvsroot/slime/ChangeLog	2009/08/08 21:45:11	1.1824
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/09 14:07:47	1.1825
@@ -1,3 +1,10 @@
+2009-08-09  Stas Boukarev  <stassats at gmail.com>
+
+	* slime.el (slime-profile-by-substring): new function for profiling
+	functions by matching a substring.
+
+	* swank.lisp (profile-by-substring): ditto.
+
 2009-08-08  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	M-n / M-p in a .lisp buffer now also jump to the respective note
--- /project/slime/cvsroot/slime/slime.el	2009/08/08 21:45:11	1.1204
+++ /project/slime/cvsroot/slime/slime.el	2009/08/09 14:07:47	1.1205
@@ -4611,7 +4611,17 @@
   (slime-eval-async `(swank:profile-package ,package ,callers ,methods)
                     (lambda (r) (message "%s" r))))
 
-
+(defun slime-profile-by-substring (substring &optional package)
+  "Profile all functions which names contain SUBSTRING.
+If PACKAGE is NIL, then search in all packages."
+  (interactive (list
+                (slime-read-from-minibuffer 
+                 "Profile by matching substring: "
+                 (slime-symbol-at-point))
+                (slime-read-package-name "Package (RET for all packages): ")))
+  (let ((package (unless (equal package "") package)))
+    (slime-eval-async `(swank:profile-by-substring ,substring ,package)
+                      (lambda (r) (message "%s" r)) )))
 
 ;;;; Documentation
 
@@ -6887,6 +6897,7 @@
       ("Profiling"
        [ "Toggle Profiling..."     slime-toggle-profile-fdefinition ,C ]
        [ "Profile Package"         slime-profile-package ,C]
+       [ "Profile by Substring"    slime-profile-by-substring ,C ]
        [ "Unprofile All"           slime-unprofile-all ,C ]
        [ "Show Profiled"           slime-profiled-functions ,C ]
        "--"
--- /project/slime/cvsroot/slime/swank.lisp	2009/07/06 11:22:47	1.655
+++ /project/slime/cvsroot/slime/swank.lisp	2009/08/09 14:07:47	1.656
@@ -3186,6 +3186,24 @@
            (profile fname)
 	   (format nil "~S is now profiled." fname)))))
 
+(defslimefun profile-by-substring (substring package)
+  (let ((count 0))
+    (flet ((maybe-profile (symbol)
+             (when (and (fboundp symbol)
+                        (not (profiledp symbol))
+                        (search substring (symbol-name symbol) :test #'equalp))
+               (handler-case (progn
+                               (profile symbol)
+                               (incf count))
+                 (error (condition)
+                   (warn "~a" condition))))))
+      (if package
+          (do-symbols (symbol (parse-package package))
+            (maybe-profile symbol))
+          (do-all-symbols (symbol)
+            (maybe-profile symbol))))
+    (format nil "~a function~:p ~:*~[are~;is~:;are~] now profiled" count)))
+
 
 ;;;; Source Locations
 




From sboukarev at common-lisp.net  Sun Aug  9 14:07:48 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sun, 09 Aug 2009 10:07:48 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1Ma93s-0004tN-4g@common-lisp.net>

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

Modified Files:
	ChangeLog slime-fuzzy.el 
Log Message:
* slime.el (slime-profile-by-substring): new function for profiling
functions by matching a substring.

* swank.lisp (profile-by-substring): ditto.

* contrib/slime-fuzzy.el (slime-fuzzy-complete-symbol): change
`comint-completion-addsuffix' to not add space after completing
a filename.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/05 17:15:35	1.230
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/09 14:07:48	1.231
@@ -1,3 +1,9 @@
+2009-08-09  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-fuzzy.el (slime-fuzzy-complete-symbol): change
+	`comint-completion-addsuffix' to not add space after completing
+	a filename.
+
 2009-08-05  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-fancy-inspector.lisp (emacs-inspect): add buttons for removing
--- /project/slime/cvsroot/slime/contrib/slime-fuzzy.el	2009/07/22 11:25:28	1.11
+++ /project/slime/cvsroot/slime/contrib/slime-fuzzy.el	2009/08/09 14:07:48	1.12
@@ -258,10 +258,12 @@
   "Fuzzily completes the abbreviation at point into a symbol."
   (interactive)
   (when (save-excursion (re-search-backward "\"[^ \t\n]+\\=" nil t))
-    (return-from slime-fuzzy-complete-symbol 
-      (if slime-when-complete-filename-expand
-          (comint-replace-by-expanded-filename)
-        (comint-dynamic-complete-as-filename))))
+    (return-from slime-fuzzy-complete-symbol
+      ;; don't add space after completion
+      (let ((comint-completion-addsuffix '("/" . "")))
+        (if slime-when-complete-filename-expand
+            (comint-replace-by-expanded-filename)
+            (comint-dynamic-complete-as-filename)))))
   (let* ((end (move-marker (make-marker) (slime-symbol-end-pos)))
          (beg (move-marker (make-marker) (slime-symbol-start-pos)))
          (prefix (buffer-substring-no-properties beg end)))




From sboukarev at common-lisp.net  Sun Aug  9 14:07:48 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sun, 09 Aug 2009 10:07:48 -0400
Subject: [slime-cvs] CVS slime/doc
Message-ID: <E1Ma93s-0004te-Ci@common-lisp.net>

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

Modified Files:
	slime.texi 
Log Message:
* slime.el (slime-profile-by-substring): new function for profiling
functions by matching a substring.

* swank.lisp (profile-by-substring): ditto.

* contrib/slime-fuzzy.el (slime-fuzzy-complete-symbol): change
`comint-completion-addsuffix' to not add space after completing
a filename.


--- /project/slime/cvsroot/slime/doc/slime.texi	2009/07/30 23:27:05	1.76
+++ /project/slime/cvsroot/slime/doc/slime.texi	2009/08/09 14:07:48	1.77
@@ -12,7 +12,7 @@
 @set EDITION 3.0-alpha
 @set SLIMEVER 3.0-alpha
 @c @set UPDATED @today{}
- at set UPDATED @code{$Date: 2009/07/30 23:27:05 $}
+ at set UPDATED @code{$Date: 2009/08/09 14:07:48 $}
 @set TITLE SLIME User Manual
 @settitle @value{TITLE}, version @value{EDITION}
 
@@ -1252,6 +1252,8 @@
 Toggle profiling of a function.
 @cmditem{slime-profile-package}
 Profile all functions in a package.
+ at cmditem{slime-profile-by-substring}
+Profile all functions which names contain a substring.
 @cmditem{slime-unprofile-all}
 Unprofile all functions.
 @cmditem{slime-profile-report}




From sboukarev at common-lisp.net  Sun Aug  9 16:10:17 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sun, 09 Aug 2009 12:10:17 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MaAyP-0005dC-Bo@common-lisp.net>

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

Modified Files:
	ChangeLog swank.asd 
Log Message:
* swank.asd (asdf:perform): don't call `swank-loader:init' with
:setup nil, because it doesn't get contribs compiled, and some other
configuration steps are omitted.


--- /project/slime/cvsroot/slime/ChangeLog	2009/08/09 14:07:47	1.1825
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/09 16:10:17	1.1826
@@ -1,5 +1,9 @@
 2009-08-09  Stas Boukarev  <stassats at gmail.com>
 
+	* swank.asd (asdf:perform): don't call `swank-loader:init' with
+	:setup nil, because it doesn't get contribs compiled, and some other
+	configuration steps are omitted.
+
 	* slime.el (slime-profile-by-substring): new function for profiling
 	functions by matching a substring.
 
--- /project/slime/cvsroot/slime/swank.asd	2008/04/17 15:21:57	1.9
+++ /project/slime/cvsroot/slime/swank.asd	2009/08/09 16:10:17	1.10
@@ -32,8 +32,7 @@
   (load (asdf::component-pathname f))
   (funcall (read-from-string "swank-loader::init")
            :reload (asdf::operation-forced o)
-           :delete (asdf::operation-forced o)
-	   :setup nil))
+           :delete (asdf::operation-forced o)))
 
 (asdf:defsystem :swank
   :default-component-class swank-loader-file




From trittweiler at common-lisp.net  Sun Aug  9 18:52:17 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sun, 09 Aug 2009 14:52:17 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MaDVB-0006OT-Dz@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
	M-n/M-p in .lisp buffers do not show the note in the minibuffer
	anymore if a compilation log is displayed to the user.

	In the compilation log, sort and group the notes by line/column
	number.

	* slime.el (slime-insert-compilation-log): Sort the notes by their
	line/column numbers; group notes of same location and display them
	as one entry.
	(slime-compilation-loc): Removed.
	(slime-canonicalized-location),
	(slime-canonicalized-location-to-string): Extracted from
	`slime-compilation-loc'.
	(slime-group-and-sort-notes): Does the sorting/grouping.
	(slime-show-note): Do not show note in minibuffer if compilation
	log is displayed to the user.


--- /project/slime/cvsroot/slime/slime.el	2009/08/09 14:07:47	1.1205
+++ /project/slime/cvsroot/slime/slime.el	2009/08/09 18:52:17	1.1206
@@ -2962,36 +2962,71 @@
 
 (defun slime-insert-compilation-log (notes)
   "Insert NOTES in format suitable for `compilation-mode'."
-  (with-temp-message "Preparing compilation log..."
-    (compilation-mode)
-    (set (make-local-variable 'compilation-skip-threshold) 0)
-    (set (make-local-variable 'compilation-skip-to-next-location) nil)
-    (let ((inhibit-read-only t))
-      (insert (format "cd %s\n%d compiler notes:\n" 
-                      default-directory (length notes)))
-      (dolist (note notes)
-        (let ((start (1+ (point))))     ; 1+ due to \n
-          (insert (format "\n%s%s:\n"
-                          (slime-compilation-loc (slime-note.location note))
-                          (slime-severity-label (slime-note.severity note))))
-          (slime-with-rigid-indentation 2
-            (insert (slime-note.message note))
-            (insert "\n"))
-          (slime-make-note-overlay note start (point)))))
-    (setq next-error-last-buffer (current-buffer))))
-
-(defun slime-compilation-loc (location)
-  (cond ((slime-location-p location)
-         (destructuring-bind (filename line col)
-             (save-excursion
-               (slime-goto-location-buffer (slime-location.buffer location))
-               (save-excursion
-                 (slime-goto-source-location location)
-                 (list (or (buffer-file-name) (buffer-name))
-                       (line-number-at-pos)
-                       (1+ (current-column)))))
-           (format "%s:%d:%d: " (or filename "") line col)))
-        (t "")))
+  (multiple-value-bind (grouped-notes canonicalized-locs-table)
+      (slime-group-and-sort-notes notes)
+    (with-temp-message "Preparing compilation log..."
+      (compilation-mode)
+      (set (make-local-variable 'compilation-skip-threshold) 0)
+      (set (make-local-variable 'compilation-skip-to-next-location) nil)
+      (let ((inhibit-read-only t))
+        (insert (format "cd %s\n%d compiler notes:\n" 
+                        default-directory (length notes)))
+        (dolist (notes grouped-notes)
+          (let ((loc (gethash (first notes) canonicalized-locs-table))
+                (start (1+ (point))))   ; 1+ due to \n
+            (insert 
+             (format "\n%s:\n" (slime-canonicalized-location-to-string loc)))
+            (dolist (note notes)
+              (insert (format "  %s:\n" (slime-severity-label 
+                                         (slime-note.severity note))))
+              (slime-with-rigid-indentation 4
+                (insert (slime-note.message note))
+                (insert "\n")))
+            (slime-make-note-overlay (first notes) start (point)))))
+      (setq next-error-last-buffer (current-buffer)))))
+
+(defun slime-canonicalized-location (location)
+  "Takes a `slime-location' and returns a list consisting of
+file/buffer name, line, and column number."
+  (save-excursion
+    (slime-goto-location-buffer (slime-location.buffer location))
+    (save-excursion
+      (slime-goto-source-location location)
+      (list (or (buffer-file-name) (buffer-name))
+            (line-number-at-pos)
+            (1+ (current-column))))))
+
+(defun slime-canonicalized-location-to-string (loc)
+  (if loc
+      (destructuring-bind (filename line col) loc
+        (format "%s:%d:%d" (or filename "") line col))
+      (format "Unknown location")))
+
+(defun slime-group-and-sort-notes (notes)
+  "First sort, then group NOTES according to their canonicalized locs."
+  (let ((locs (make-hash-table :test #'eq)))
+    (mapc #'(lambda (note)
+              (let ((loc (slime-note.location note)))
+                (when (slime-location-p loc)
+                  (puthash note (slime-canonicalized-location loc) locs))))
+          notes)
+    (values (slime-group-similar 
+             #'(lambda (n1 n2)
+                 (equal (gethash n1 locs nil) (gethash n2 locs t)))
+             (let* ((bottom most-negative-fixnum) 
+                    (+default+ (list "" bottom bottom)))
+               (sort notes
+                     #'(lambda (n1 n2)
+                         (destructuring-bind (filename1 line1 col1) 
+                             (gethash n1 locs +default+)
+                           (destructuring-bind (filename2 line2 col2) 
+                               (gethash n2 locs +default+)
+                             (cond ((string-lessp filename1 filename2) t)
+                                   ((string-lessp filename2 filename1) nil)
+                                   ((< line1 line2) t)
+                                   ((> line1 line2) nil)
+                                   (t (< col1 col2)))))))))
+            locs)))
 
 (defun slime-goto-note-in-compilation-log (note)
   "Try to find `note' in the compilation log, and display it to
@@ -3590,10 +3625,10 @@
 (defun slime-show-note (overlay)
   "Present the details of a compiler note to the user."
   (slime-temporarily-highlight-note overlay)
-  (when (get-buffer-window "*SLIME Compilation*" t)
-    (slime-goto-note-in-compilation-log (overlay-get overlay 'slime-note)))
-  (let ((message (get-char-property (point) 'help-echo)))
-    (slime-message "%s" (if (zerop (length message)) "\"\"" message))))
+  (if (get-buffer-window "*SLIME Compilation*" t)
+      (slime-goto-note-in-compilation-log (overlay-get overlay 'slime-note))
+      (let ((message (get-char-property (point) 'help-echo)))
+        (slime-message "%s" (if (zerop (length message)) "\"\"" message)))))
 
 (defun slime-temporarily-highlight-note (overlay)
   "Temporarily highlight a compiler note's overlay.
--- /project/slime/cvsroot/slime/ChangeLog	2009/08/09 16:10:17	1.1826
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/09 18:52:17	1.1827
@@ -1,3 +1,22 @@
+2009-08-09  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	M-n/M-p in .lisp buffers do not show the note in the minibuffer
+	anymore if a compilation log is displayed to the user.
+
+	In the compilation log, sort and group the notes by line/column
+	number.
+
+	* slime.el (slime-insert-compilation-log): Sort the notes by their
+	line/column numbers; group notes of same location and display them
+	as one entry.
+	(slime-compilation-loc): Removed.
+	(slime-canonicalized-location),
+	(slime-canonicalized-location-to-string): Extracted from
+	`slime-compilation-loc'.
+	(slime-group-and-sort-notes): Does the sorting/grouping.
+	(slime-show-note): Do not show note in minibuffer if compilation
+	log is displayed to the user.
+
 2009-08-09  Stas Boukarev  <stassats at gmail.com>
 
 	* swank.asd (asdf:perform): don't call `swank-loader:init' with




From trittweiler at common-lisp.net  Sun Aug  9 19:22:43 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sun, 09 Aug 2009 15:22:43 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MaDyd-0008Mw-1V@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
	Make C-x ` work again.

	M-n and C-x ` are now very similiar; but the former operates
	relative to point in the source buffer, while the latter works
	relative to the compilation log.

	* slime.el (slime-insert-compilation-log): No do set
	`compilation-skip-to-next-location'.


--- /project/slime/cvsroot/slime/slime.el	2009/08/09 18:52:17	1.1206
+++ /project/slime/cvsroot/slime/slime.el	2009/08/09 19:22:42	1.1207
@@ -2967,7 +2967,6 @@
     (with-temp-message "Preparing compilation log..."
       (compilation-mode)
       (set (make-local-variable 'compilation-skip-threshold) 0)
-      (set (make-local-variable 'compilation-skip-to-next-location) nil)
       (let ((inhibit-read-only t))
         (insert (format "cd %s\n%d compiler notes:\n" 
                         default-directory (length notes)))
--- /project/slime/cvsroot/slime/ChangeLog	2009/08/09 18:52:17	1.1827
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/09 19:22:42	1.1828
@@ -1,5 +1,16 @@
 2009-08-09  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	Make C-x ` work again.
+
+	M-n and C-x ` are now very similiar; but the former operates
+	relative to point in the source buffer, while the latter works
+	relative to the compilation log.
+
+	* slime.el (slime-insert-compilation-log): No do set
+	`compilation-skip-to-next-location'.
+
+2009-08-09  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	M-n/M-p in .lisp buffers do not show the note in the minibuffer
 	anymore if a compilation log is displayed to the user.
 




From heller at common-lisp.net  Mon Aug 10 19:29:56 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 10 Aug 2009 15:29:56 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MaaZA-0007EF-1K@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Various compilation related changes.

* slime.el (slime-show-note-counts): Don't show 0 values.
(slime-severity<): New function.
(slime-maybe-show-compilation-log): Always create the log buffer
but display it only if the compilation failed.
(slime-insert-compilation-log): Disable the stupidly inefficient
font-lock-after-change-function.
(slime-canonicalized-location-to-string): Use relative filenames.
(slime-goto-location-buffer): Disable warnings about symlinks.

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/09 19:22:42	1.1828
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/10 19:29:55	1.1829
@@ -1,3 +1,16 @@
+2009-08-10  Helmut Eller  <heller at common-lisp.net>
+
+	Various compilation related changes.
+
+	* slime.el (slime-show-note-counts): Don't show 0 values.
+	(slime-severity<): New function.
+	(slime-maybe-show-compilation-log): Always create the log buffer
+	but display it only if the compilation failed.
+	(slime-insert-compilation-log): Disable the stupidly inefficient
+	font-lock-after-change-function.
+	(slime-canonicalized-location-to-string): Use relative filenames.
+	(slime-goto-location-buffer): Disable warnings about symlinks.
+
 2009-08-09  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	Make C-x ` work again.
--- /project/slime/cvsroot/slime/slime.el	2009/08/09 19:22:42	1.1207
+++ /project/slime/cvsroot/slime/slime.el	2009/08/10 19:29:55	1.1208
@@ -2771,28 +2771,21 @@
     (run-hook-with-args 'slime-compilation-finished-hook notes)))
 
 (defun slime-show-note-counts (notes secs successp)
-  (let ((nerrors 0) (nwarnings 0) (nstyle-warnings 0) (nnotes 0))
-    (dolist (note notes)
-      (ecase (slime-note.severity note)
-	((:error :read-error)           (incf nerrors))
-        ((:warning)                     (incf nwarnings))
-        ((:redefinition :style-warning) (incf nstyle-warnings))
-        ((:note)                        (incf nnotes))))
-    (message "%s:%s%s%s%s%s"
-             (if successp 
-                 "Compilation finished" 
-                 (slime-add-face '(:foreground "Red")
-                   "Compilation failed"))
-             (slime-note-count-string "error" nerrors)
-             (slime-note-count-string "warning" nwarnings)
-             (slime-note-count-string "style-warning" nstyle-warnings t)
-             (slime-note-count-string "note" nnotes)
-             (if secs (format "[%.2f secs]" secs) ""))))
-
-(defun slime-note-count-string (severity count &optional suppress-if-zero)
-  (cond ((and (zerop count) suppress-if-zero)
-         "")
-        (t (format "%2d %s%s " count severity (if (= count 1) "" "s")))))
+  (message (concat 
+            (cond (successp "Compilation finished")
+                  (t (slime-add-face 'font-lock-warning-face
+                       "Compilation failed")))
+            (if (null notes) ". (No warnings)" ": ")
+            (mapconcat
+             (lambda (messages)
+               (destructuring-bind (sev . notes) messages
+                 (let ((len (length notes)))
+                   (format "%d %s%s" len (slime-severity-label sev) 
+                           (if (= len 1) "" "s")))))
+             (sort (slime-alistify notes #'slime-note.severity #'eq)
+                   (lambda (x y) (slime-severity< (car y) (car x))))
+             "  ")
+            (if secs (format "  [%.2f secs]" secs)))))
 
 (defun slime-highlight-notes (notes)
   "Highlight compiler notes, warnings, and errors in the buffer."
@@ -2944,16 +2937,16 @@
 
 (defun slime-maybe-show-compilation-log (notes)
   "Display the log on failed compilations or if NOTES is non-nil."
+  (slime-create-compilation-log notes)
   (with-struct (slime-compilation-result. notes duration successp)
       slime-last-compilation-result
-    (when (or (and notes (not (every #'slime-redefinition-note-p notes)))
-              (not successp))
-      (slime-with-popup-buffer ("*SLIME Compilation*")
-        (slime-insert-compilation-log notes)
+    (unless successp
+      (with-current-buffer "*SLIME Compilation*"
         (let ((inhibit-read-only t))
           (goto-char (point-max))
           (insert "\nCompilation " (if successp "succeeded." "failed."))
-          (goto-char (point-min)))))))
+          (goto-char (point-min))
+          (display-buffer (current-buffer)))))))
 
 (defun slime-show-compilation-log (notes)
   (interactive (list (slime-compiler-notes)))
@@ -2965,9 +2958,8 @@
   (multiple-value-bind (grouped-notes canonicalized-locs-table)
       (slime-group-and-sort-notes notes)
     (with-temp-message "Preparing compilation log..."
-      (compilation-mode)
-      (set (make-local-variable 'compilation-skip-threshold) 0)
-      (let ((inhibit-read-only t))
+      (let ((inhibit-read-only t)
+            (inhibit-modification-hooks t)) ; inefficient font-lock-hook
         (insert (format "cd %s\n%d compiler notes:\n" 
                         default-directory (length notes)))
         (dolist (notes grouped-notes)
@@ -2982,6 +2974,8 @@
                 (insert (slime-note.message note))
                 (insert "\n")))
             (slime-make-note-overlay (first notes) start (point)))))
+      (compilation-mode)
+      (set (make-local-variable 'compilation-skip-threshold) 0)
       (setq next-error-last-buffer (current-buffer)))))
 
 (defun slime-canonicalized-location (location)
@@ -2998,7 +2992,9 @@
 (defun slime-canonicalized-location-to-string (loc)
   (if loc
       (destructuring-bind (filename line col) loc
-        (format "%s:%d:%d" (or filename "") line col))
+        (format "%s:%d:%d" 
+                (if filename (file-relative-name filename) "") 
+                line col))
       (format "Unknown location")))
 
 (defun slime-group-and-sort-notes (notes)
@@ -3182,15 +3178,17 @@
     (:style-warning 'slime-style-warning-face)
     (:note          'slime-note-face)))
 
+(defvar slime-severity-order 
+  '(:note :style-warning :redefinition :warning :error :read-error))
+
+(defun slime-severity< (sev1 sev2)
+  "Return true if SEV1 is less severe than SEV2."
+  (< (position sev1 slime-severity-order)
+     (position sev2 slime-severity-order)))
+
 (defun slime-most-severe (sev1 sev2)
-  "Return the most servere of two conditions.
-Severity is ordered as :NOTE < :STYLE-WARNING < :WARNING < :ERROR."
-                                        ; Well, not exactly Smullyan..
-  (let ((order '(:note :style-warning :warning :error :read-error)))
-    (if (>= (position sev1 order) 
-            (position sev2 order))
-        sev1
-      sev2)))
+  "Return the most servere of two conditions."
+  (if (slime-severity< sev1 sev2) sev2 sev1))
 
 ;; XXX: unused function
 (defun slime-visit-source-path (source-path)
@@ -3384,7 +3382,8 @@
      (let ((filename (slime-from-lisp-filename filename)))
        (slime-check-location-filename-sanity filename)
        (set-buffer (or (get-file-buffer filename)
-                       (find-file-noselect filename)))))
+                       (let ((find-file-suppress-same-file-warnings t))
+                         (find-file-noselect filename))))))
     ((:buffer buffer-name)
      (slime-check-location-buffer-name-sanity buffer-name)
      (set-buffer buffer-name))
@@ -3671,17 +3670,15 @@
 (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.
-Retuns the note overlay if such a position is found, otherwise nil.
-"
+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)))
-    (if overlay
-        overlay
-        (prog1 nil (goto-char origin)))))
+    (unless overlay (goto-char origin))
+    overlay))
 
 
 ;;;; Arglist Display
@@ -8921,7 +8918,6 @@
           slime-net-decode-length
           slime-net-read
           slime-print-apropos
-          slime-show-note-counts
           slime-insert-propertized
           slime-tree-insert
           slime-symbol-constituent-at




From heller at common-lisp.net  Mon Aug 10 19:30:04 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 10 Aug 2009 15:30:04 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MaaZI-0007PV-Kp@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Don't add linebreaks for one-line messages.

(slime-insert-block): New function.
(slime-insert-compilation-log): Use it.
(slime-indent-rigidly): Use insert-before-markers, otherwise point
ends up at before a bunch of inserted spaces.

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/10 19:29:55	1.1829
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/10 19:30:04	1.1830
@@ -1,5 +1,14 @@
 2009-08-10  Helmut Eller  <heller at common-lisp.net>
 
+	Don't add linebreaks for one-line messages.
+
+	(slime-insert-block): New function.
+	(slime-insert-compilation-log): Use it.
+	(slime-indent-rigidly): Use insert-before-markers, otherwise point
+	ends up at before a bunch of inserted spaces.
+
+2009-08-10  Helmut Eller  <heller at common-lisp.net>
+
 	Various compilation related changes.
 
 	* slime.el (slime-show-note-counts): Don't show 0 values.
--- /project/slime/cvsroot/slime/slime.el	2009/08/10 19:29:55	1.1208
+++ /project/slime/cvsroot/slime/slime.el	2009/08/10 19:30:04	1.1209
@@ -909,13 +909,14 @@
 
 (defun slime-indent-rigidly (start end column)
   ;; Similar to `indent-rigidly' but doesn't inherit text props.
-  (save-excursion
-    (goto-char end)
-    (beginning-of-line)
-    (while (and (<= start (point))
-                (progn
-                  (save-excursion (insert-char ?\  column))
-                  (zerop (forward-line -1)))))))
+  (let ((indent (make-string column ?\ )))
+    (save-excursion
+      (goto-char end)
+      (beginning-of-line)
+      (while (and (<= start (point))
+                  (progn
+                    (insert-before-markers indent)
+                    (zerop (forward-line -1))))))))
 
 (defun slime-insert-indented (&rest strings)
   "Insert all arguments rigidly indented."
@@ -2944,7 +2945,7 @@
       (with-current-buffer "*SLIME Compilation*"
         (let ((inhibit-read-only t))
           (goto-char (point-max))
-          (insert "\nCompilation " (if successp "succeeded." "failed."))
+          (insert "Compilation " (if successp "succeeded." "failed."))
           (goto-char (point-min))
           (display-buffer (current-buffer)))))))
 
@@ -2960,24 +2961,30 @@
     (with-temp-message "Preparing compilation log..."
       (let ((inhibit-read-only t)
             (inhibit-modification-hooks t)) ; inefficient font-lock-hook
-        (insert (format "cd %s\n%d compiler notes:\n" 
+        (insert (format "cd %s\n%d compiler notes:\n\n"
                         default-directory (length notes)))
         (dolist (notes grouped-notes)
           (let ((loc (gethash (first notes) canonicalized-locs-table))
-                (start (1+ (point))))   ; 1+ due to \n
-            (insert 
-             (format "\n%s:\n" (slime-canonicalized-location-to-string loc)))
+                (start (point)))
+            (insert (slime-canonicalized-location-to-string loc) ":\n")
             (dolist (note notes)
-              (insert (format "  %s:\n" (slime-severity-label 
-                                         (slime-note.severity note))))
-              (slime-with-rigid-indentation 4
-                (insert (slime-note.message note))
-                (insert "\n")))
-            (slime-make-note-overlay (first notes) start (point)))))
+              (insert "  ")
+              (insert (slime-severity-label (slime-note.severity note)) ": ")
+              (slime-insert-block (slime-note.message note) 4)
+              (insert "\n"))
+            (insert "\n")
+            (slime-make-note-overlay (first notes) start (1- (point))))))
       (compilation-mode)
       (set (make-local-variable 'compilation-skip-threshold) 0)
       (setq next-error-last-buffer (current-buffer)))))
 
+(defun slime-insert-block (string indentation)
+  "Insert TEXT.  If it takes multiple lines, indent it."
+  (cond ((string-match "\n" string)
+         (insert "\n")
+         (slime-with-rigid-indentation indentation (insert string)))
+        (t (insert string))))
+
 (defun slime-canonicalized-location (location)
   "Takes a `slime-location' and returns a list consisting of
 file/buffer name, line, and column number."
@@ -2993,7 +3000,11 @@
   (if loc
       (destructuring-bind (filename line col) loc
         (format "%s:%d:%d" 
-                (if filename (file-relative-name filename) "") 
+                (cond ((not filename) "")
+                      ((let ((rel (file-relative-name filename)))
+                         (if (< (length rel) (length filename))
+                             rel)))
+                      (t filename))
                 line col))
       (format "Unknown location")))
 




From heller at common-lisp.net  Mon Aug 10 19:30:22 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 10 Aug 2009 15:30:22 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MaaZa-0007QF-Ti@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el swank-backend.lisp swank-ccl.lisp 
	swank-cmucl.lisp swank-openmcl.lisp swank-sbcl.lisp 
	swank-scl.lisp swank.lisp 
Log Message:
Separate context info from compiler message text.

* swank-backend.lisp (compiler-condition): Add a new slot
:source-context.  Remove :short-message.
* swank-cmucl.lisp, swank-sbcl.lisp, swank-scl.lisp,
swank-openmcl.lisp, swank-ccl.lisp: Update callers.
* swank.lisp (make-compiler-note): Use source-context slot.
* slime.el (slime-note.source-context): New.
(slime-insert-compilation-log): Use it.
(slime-note.short-message): Deleted.

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/10 19:30:04	1.1830
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/10 19:30:22	1.1831
@@ -1,5 +1,18 @@
 2009-08-10  Helmut Eller  <heller at common-lisp.net>
 
+	Separate context info from compiler message text.
+
+	* swank-backend.lisp (compiler-condition): Add a new slot
+	:source-context.  Remove :short-message.
+	* swank-cmucl.lisp, swank-sbcl.lisp, swank-scl.lisp,
+	swank-openmcl.lisp, swank-ccl.lisp: Update callers.
+	* swank.lisp (make-compiler-note): Use source-context slot.
+	* slime.el (slime-note.source-context): New.
+	(slime-insert-compilation-log): Use it.
+	(slime-note.short-message): Deleted.
+
+2009-08-10  Helmut Eller  <heller at common-lisp.net>
+
 	Don't add linebreaks for one-line messages.
 
 	(slime-insert-block): New function.
--- /project/slime/cvsroot/slime/slime.el	2009/08/10 19:30:04	1.1209
+++ /project/slime/cvsroot/slime/slime.el	2009/08/10 19:30:22	1.1210
@@ -2856,7 +2856,7 @@
   "Merge NOTES together. Keep the highest severity, concatenate the messages."
   (let* ((new-severity (reduce #'slime-most-severe notes
                                :key #'slime-note.severity))
-         (new-message (mapconcat #'slime-note.short-message notes "\n")))
+         (new-message (mapconcat #'slime-note.message notes "\n")))
     (let ((new-note (copy-list (car notes))))
       (setf (getf new-note :message) new-message)
       (setf (getf new-note :severity) new-severity)
@@ -2970,7 +2970,11 @@
             (dolist (note notes)
               (insert "  ")
               (insert (slime-severity-label (slime-note.severity note)) ": ")
-              (slime-insert-block (slime-note.message note) 4)
+              (slime-insert-block
+               (concat (slime-note.message note)
+                       (let ((ctx (slime-note.source-context note)))
+                         (if ctx (format "\n%s" ctx))))
+               4)
               (insert "\n"))
             (insert "\n")
             (slime-make-note-overlay (first notes) start (1- (point))))))
@@ -3073,9 +3077,8 @@
 (defun slime-note.message (note)
   (plist-get note :message))
 
-(defun slime-note.short-message (note)
-  (or (plist-get note :short-message)
-      (plist-get note :message)))
+(defun slime-note.source-context (note)
+  (plist-get note :source-context))
 
 (defun slime-note.location (note)
   (plist-get note :location))
--- /project/slime/cvsroot/slime/swank-backend.lisp	2009/08/02 12:57:23	1.179
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2009/08/10 19:30:22	1.180
@@ -16,7 +16,7 @@
            #:compiler-condition
            #:original-condition
            #:message
-           #:short-message
+           #:source-context
            #:condition
            #:severity
            #:with-compilation-hooks
@@ -428,9 +428,12 @@
    (message :initarg :message
             :accessor message)
 
-   (short-message :initarg :short-message
-                  :initform nil
-                  :accessor short-message)
+   ;; Macro expansion history etc. which may be helpful in some cases
+   ;; but is often very verbose.
+   (source-context :initarg :source-context
+                   :type (or null string)
+                   :initform nil
+                   :accessor source-context)
 
    (references :initarg :references
                :initform nil
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2009/07/27 13:08:17	1.2
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2009/08/10 19:30:22	1.3
@@ -200,8 +200,8 @@
   (signal (make-condition
            'compiler-condition
            :original-condition condition
-           :message (format nil "~A" condition)
-           :short-message (compiler-warning-short-message condition)
+           :message (compiler-warning-short-message condition)
+           :source-context nil
            :severity (compiler-warning-severity condition)
            :location (source-note-to-source-location 
                       (ccl:compiler-warning-source-note condition)
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/06/21 07:22:56	1.212
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/08/10 19:30:22	1.213
@@ -430,8 +430,8 @@
            'compiler-condition
            :original-condition condition
            :severity (severity-for-emacs condition)
-           :short-message (brief-compiler-message-for-emacs condition)
-           :message (long-compiler-message-for-emacs condition context)
+           :message (compiler-condition-message condition)
+           :source-context (compiler-error-context context)
            :location (if (read-error-p condition)
                          (read-error-location condition)
                          (compiler-note-location context)))))
@@ -447,22 +447,24 @@
 (defun read-error-p (condition)
   (eq (type-of condition) 'c::compiler-read-error))
 
-(defun brief-compiler-message-for-emacs (condition)
+(defun compiler-condition-message (condition)
   "Briefly describe a compiler error for Emacs.
 When Emacs presents the message it already has the source popped up
 and the source form highlighted. This makes much of the information in
 the error-context redundant."
   (princ-to-string condition))
 
-(defun long-compiler-message-for-emacs (condition error-context)
-  "Describe a compiler error for Emacs including context information."
+(defun compiler-error-context (error-context)
+  "Describe context information for Emacs."
   (declare (type (or c::compiler-error-context null) error-context))
   (multiple-value-bind (enclosing source)
       (if error-context
           (values (c::compiler-error-context-enclosing-source error-context)
                   (c::compiler-error-context-source error-context)))
-    (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]~A"
-            enclosing source condition)))
+    (if (or enclosing source)
+        (format nil "~@[--> ~{~<~%--> ~1:;~A ~>~}~%~]~
+                     ~@[==>~{~&~A~}~]"
+                enclosing source))))
 
 (defun read-error-location (condition)
   (let* ((finfo (car (c::source-info-current-file c::*source-info*)))
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/06/30 02:50:25	1.182
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/08/10 19:30:22	1.183
@@ -233,8 +233,8 @@
   (signal (make-condition
            'compiler-condition
            :original-condition condition
-           :message (format nil "~A" condition)
-           :short-message (compiler-warning-short-message condition)
+           :message (compiler-warning-short-message condition)
+           :source-context nil
            :severity (compiler-warning-severity condition)
            :location (source-note-to-source-location 
                       (ccl::compiler-warning-source-note condition)
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/08/04 23:54:55	1.247
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/08/10 19:30:22	1.248
@@ -443,9 +443,9 @@
                        (warning              :warning)
                        (reader-error         :read-error)
                        (error                :error))
-           :short-message (brief-compiler-message-for-emacs condition)
            :references (condition-references (real-condition condition))
-           :message (long-compiler-message-for-emacs condition context)
+           :message (brief-compiler-message-for-emacs condition)
+           :source-context (compiler-error-context context)
            :location (compiler-note-location condition context))))
 
 (defun real-condition (condition)
@@ -519,16 +519,16 @@
   (let ((sb-int:*print-condition-references* nil))
     (princ-to-string condition)))
 
-(defun long-compiler-message-for-emacs (condition error-context)
+(defun compiler-error-context (error-context)
   "Describe a compiler error for Emacs including context information."
   (declare (type (or sb-c::compiler-error-context null) error-context))
   (multiple-value-bind (enclosing source)
       (if error-context
           (values (sb-c::compiler-error-context-enclosing-source error-context)
                   (sb-c::compiler-error-context-source error-context)))
-    (let ((sb-int:*print-condition-references* nil))
-      (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~%~}~]~A"
-              enclosing source condition))))
+    (and (or enclosing source)
+         (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~%~}~]"
+                 enclosing source))))
 
 (defun compiler-source-path (context)
   "Return the source-path for the current compiler error.
--- /project/slime/cvsroot/slime/swank-scl.lisp	2009/06/21 07:22:56	1.33
+++ /project/slime/cvsroot/slime/swank-scl.lisp	2009/08/10 19:30:22	1.34
@@ -488,8 +488,8 @@
            'compiler-condition
            :original-condition condition
            :severity (severity-for-emacs condition)
-           :short-message (brief-compiler-message-for-emacs condition)
-           :message (long-compiler-message-for-emacs condition context)
+           :message (brief-compiler-message-for-emacs condition)
+           :source-context (compiler-error-context context)
            :location (if (read-error-p condition)
                          (read-error-location condition)
                          (compiler-note-location context)))))
@@ -512,15 +512,16 @@
   the error-context redundant."
   (princ-to-string condition))
 
-(defun long-compiler-message-for-emacs (condition error-context)
+(defun compiler-error-context (error-context)
   "Describe a compiler error for Emacs including context information."
   (declare (type (or c::compiler-error-context null) error-context))
   (multiple-value-bind (enclosing source)
       (if error-context
           (values (c::compiler-error-context-enclosing-source error-context)
                   (c::compiler-error-context-source error-context)))
-    (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]~A"
-            enclosing source condition)))
+    (if (and enclosing source)
+        (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]"
+                enclosing source))))
 
 (defun read-error-location (condition)
   (let* ((finfo (car (c::source-info-current-file c::*source-info*)))
--- /project/slime/cvsroot/slime/swank.lisp	2009/08/09 14:07:47	1.656
+++ /project/slime/cvsroot/slime/swank.lisp	2009/08/10 19:30:22	1.657
@@ -2765,8 +2765,8 @@
          :severity (severity condition)
          :location (location condition)
          :references (references condition)
-         (let ((s (short-message condition)))
-           (if s (list :short-message s)))))
+         (let ((s (source-context condition)))
+           (if s (list :source-context s)))))
 
 (defun collect-notes (function)
   (let ((notes '()))




From heller at common-lisp.net  Mon Aug 10 19:30:33 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 10 Aug 2009 15:30:33 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MaaZl-0007RT-7D@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Minor refactoring.

* slime.el (slime-insert-note-group): Factored out from
slime-insert-compilation-log.
(slime-goto-location-position): Can't use goto-line.

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/10 19:30:22	1.1831
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/10 19:30:32	1.1832
@@ -1,5 +1,10 @@
 2009-08-10  Helmut Eller  <heller at common-lisp.net>
 
+	* slime.el (slime-insert-note-group): Factored out from
+	slime-insert-compilation-log.
+	(slime-goto-location-position): Can't use goto-line.
+
+2009-08-10  Helmut Eller  <heller at common-lisp.net>
 	Separate context info from compiler message text.
 
 	* swank-backend.lisp (compiler-condition): Add a new slot
--- /project/slime/cvsroot/slime/slime.el	2009/08/10 19:30:22	1.1210
+++ /project/slime/cvsroot/slime/slime.el	2009/08/10 19:30:33	1.1211
@@ -2966,28 +2966,33 @@
         (dolist (notes grouped-notes)
           (let ((loc (gethash (first notes) canonicalized-locs-table))
                 (start (point)))
-            (insert (slime-canonicalized-location-to-string loc) ":\n")
-            (dolist (note notes)
-              (insert "  ")
-              (insert (slime-severity-label (slime-note.severity note)) ": ")
-              (slime-insert-block
-               (concat (slime-note.message note)
-                       (let ((ctx (slime-note.source-context note)))
-                         (if ctx (format "\n%s" ctx))))
-               4)
-              (insert "\n"))
+            (insert (slime-canonicalized-location-to-string loc) ":")
+            (slime-insert-note-group notes)
             (insert "\n")
             (slime-make-note-overlay (first notes) start (1- (point))))))
       (compilation-mode)
       (set (make-local-variable 'compilation-skip-threshold) 0)
       (setq next-error-last-buffer (current-buffer)))))
 
-(defun slime-insert-block (string indentation)
-  "Insert TEXT.  If it takes multiple lines, indent it."
-  (cond ((string-match "\n" string)
-         (insert "\n")
-         (slime-with-rigid-indentation indentation (insert string)))
-        (t (insert string))))
+(defun slime-insert-note-group (notes)
+  "Insert a group of compiler messages."
+  (insert "\n")
+  (dolist (note notes)
+    (insert "  " (slime-severity-label (slime-note.severity note)) ": ")
+    (let ((start (point)))
+      (insert (slime-note.message note))
+      (let ((ctx (slime-note.source-context note)))
+        (if ctx (insert "\n" ctx)))
+      (slime-indent-block start 4))
+    (insert "\n")))
+
+(defun slime-indent-block (start column)
+  "If the region back to START isn't a one-liner indent it."
+  (when (< start (line-beginning-position))
+    (save-excursion 
+      (goto-char start) 
+      (insert "\n"))
+    (slime-indent-rigidly start (point) column)))
 
 (defun slime-canonicalized-location (location)
   "Takes a `slime-location' and returns a list consisting of
@@ -3427,7 +3432,8 @@
      (goto-char start)
      (forward-char offset))
     ((:line start &optional column)
-     (goto-line start)
+     (goto-char (point-min))
+     (beginning-of-line start)
      (cond (column (move-to-column column))
            (t (skip-chars-forward " \t"))))
     ((:function-name name)




From trittweiler at common-lisp.net  Tue Aug 11 09:15:03 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 11 Aug 2009 05:15:03 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1ManRf-0007hN-8H@common-lisp.net>

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
	* swank-sbcl.lisp (swank-compile-string): Make sure that it
	returns NIL on compilation failure.


--- /project/slime/cvsroot/slime/ChangeLog	2009/08/10 19:30:32	1.1832
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/11 09:15:02	1.1833
@@ -1,3 +1,8 @@
+2009-08-11  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-sbcl.lisp (swank-compile-string): Make sure that it
+	returns NIL on compilation failure.
+
 2009-08-10  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-insert-note-group): Factored out from
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/08/10 19:30:22	1.248
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/08/11 09:15:03	1.249
@@ -629,7 +629,10 @@
                                         :emacs-filename filename
                                         :emacs-string string
                                         :emacs-position position))
-                 (funcall cont (compile-file temp-file-name))))))
+                 (multiple-value-bind (output-file warningsp failurep)
+                     (compile-file temp-file-name)
+                   (unless failurep
+                     (funcall cont output-file)))))))
       (with-open-file (s temp-file-name :direction :output :if-exists :error)
         (write-string string s))
       (unwind-protect




From trittweiler at common-lisp.net  Tue Aug 11 17:08:21 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 11 Aug 2009 13:08:21 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1Mauph-0006Ct-8B@common-lisp.net>

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

Modified Files:
	ChangeLog slime-autodoc.el 
Log Message:
	* slime-autodoc.el (slime-arglist): Pass properly formed argument
	in the rpc call.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/09 14:07:48	1.231
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/11 17:08:21	1.232
@@ -1,3 +1,8 @@
+2009-08-11  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-autodoc.el (slime-arglist): Pass properly formed argument
+	in the rpc call.
+
 2009-08-09  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-fuzzy.el (slime-fuzzy-complete-symbol): change
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/05/02 09:11:08	1.16
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/08/11 17:08:21	1.17
@@ -37,12 +37,10 @@
 (defun slime-arglist (name)
   "Show the argument list for NAME."
   (interactive (list (slime-read-symbol-name "Arglist of: ")))
-  (slime-eval-async 
-   `(swank:arglist-for-echo-area (quote (,name)))
-   (lambda (arglist)
-     (if arglist
-         (message "%s" (slime-fontify-string arglist))
-       (error "Arglist not available")))))
+  (let ((arglist (slime-eval `(swank:arglist-for-echo-area '((,name))))))
+    (if arglist
+        (message "%s" (slime-fontify-string arglist))
+        (error "Arglist not available"))))
 
 
 ;;;; Autodocs (automatic context-sensitive help)




From sboukarev at common-lisp.net  Thu Aug 13 22:34:39 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Thu, 13 Aug 2009 18:34:39 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MbisZ-0000jU-Kw@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-auto-select-connection, slime-auto-connect):
Turn them into customizable variables.


--- /project/slime/cvsroot/slime/ChangeLog	2009/08/11 09:15:02	1.1833
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/13 22:34:39	1.1834
@@ -1,3 +1,8 @@
+2009-08-13  Stas Boukarev  <stassats at gmail.com>
+
+	* slime.el (slime-auto-select-connection, slime-auto-connect):
+	Turn them into customizable variables.
+
 2009-08-11  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-sbcl.lisp (swank-compile-string): Make sure that it
--- /project/slime/cvsroot/slime/slime.el	2009/08/10 19:30:33	1.1211
+++ /project/slime/cvsroot/slime/slime.el	2009/08/13 22:34:39	1.1212
@@ -1867,7 +1867,13 @@
            (error "Connection closed."))
           (t conn))))
 
-(defvar slime-auto-connect 'never)
+(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."
+  :group 'slime-mode
+  :type '(choice (const never)
+                 (const always)
+                 (const ask)))
 
 (defun slime-auto-connect ()
   (cond ((or (eq slime-auto-connect 'always)
@@ -1880,7 +1886,12 @@
            (slime-connection)))
         (t nil)))
 
-(defvar slime-auto-select-connection 'ask)
+(defcustom slime-auto-select-connection 'ask
+  "Controls auto selection after the default connection was quited."
+  :group 'slime-mode
+  :type '(choice (const never)
+                 (const always)
+                 (const ask)))
 
 (defun slime-auto-select-connection ()
   (let* ((c0 (car slime-net-processes))




From heller at common-lisp.net  Sat Aug 15 08:34:49 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 15 Aug 2009 04:34:49 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1McEiv-0000FN-6j@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-choose-overlay-region): Don't return zero length
regions for :eof.
(slime-show-buffer-position): The second argument to
display-buffer means something completely different in
XEmacs. Don't use it.
(slime-severity-face): Handle :redefinition.
(slime-temporarily-highlight-note): Use a timer instead of the
post-command-hook.

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/13 22:34:39	1.1834
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/15 08:34:48	1.1835
@@ -8,6 +8,17 @@
 	* swank-sbcl.lisp (swank-compile-string): Make sure that it
 	returns NIL on compilation failure.
 
+2009-08-15  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-choose-overlay-region): Don't return zero length
+	regions for :eof.
+	(slime-show-buffer-position): The second argument to
+	display-buffer means something completely different in
+	XEmacs. Don't use it.
+	(slime-severity-face): Handle :redefinition.
+	(slime-temporarily-highlight-note): Use a timer instead of the
+	post-command-hook.
+
 2009-08-10  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-insert-note-group): Factored out from
--- /project/slime/cvsroot/slime/slime.el	2009/08/13 22:34:39	1.1212
+++ /project/slime/cvsroot/slime/slime.el	2009/08/15 08:34:48	1.1213
@@ -3028,35 +3028,8 @@
                 line col))
       (format "Unknown location")))
 
-(defun slime-group-and-sort-notes (notes)
-  "First sort, then group NOTES according to their canonicalized locs."
-  (let ((locs (make-hash-table :test #'eq)))
-    (mapc #'(lambda (note)
-              (let ((loc (slime-note.location note)))
-                (when (slime-location-p loc)
-                  (puthash note (slime-canonicalized-location loc) locs))))
-          notes)
-    (values (slime-group-similar 
-             #'(lambda (n1 n2)
-                 (equal (gethash n1 locs nil) (gethash n2 locs t)))
-             (let* ((bottom most-negative-fixnum) 
-                    (+default+ (list "" bottom bottom)))
-               (sort notes
-                     #'(lambda (n1 n2)
-                         (destructuring-bind (filename1 line1 col1) 
-                             (gethash n1 locs +default+)
-                           (destructuring-bind (filename2 line2 col2) 
-                               (gethash n2 locs +default+)
-                             (cond ((string-lessp filename1 filename2) t)
-                                   ((string-lessp filename2 filename1) nil)
-                                   ((< line1 line2) t)
-                                   ((> line1 line2) nil)
-                                   (t (< col1 col2)))))))))
-            locs)))
-
 (defun slime-goto-note-in-compilation-log (note)
-  "Try to find `note' in the compilation log, and display it to
-the user if it's there."
+  "Find `note' in the compilation log and display it."
   (with-current-buffer (get-buffer "*SLIME Compilation*")
     (let ((origin (point))
           (foundp nil))
@@ -3071,6 +3044,32 @@
       (unless foundp
         (goto-char origin)))))
 
+(defun slime-group-and-sort-notes (notes)
+  "First sort, then group NOTES according to their canonicalized locs."
+  (let ((locs (make-hash-table :test #'eq)))
+    (mapc (lambda (note)
+            (let ((loc (slime-note.location note)))
+              (when (slime-location-p loc)
+                (puthash note (slime-canonicalized-location loc) locs))))
+          notes)
+    (values (slime-group-similar 
+             (lambda (n1 n2)
+               (equal (gethash n1 locs nil) (gethash n2 locs t)))
+             (let* ((bottom most-negative-fixnum) 
+                    (+default+ (list "" bottom bottom)))
+               (sort notes
+                     (lambda (n1 n2)
+                       (destructuring-bind (filename1 line1 col1) 
+                           (gethash n1 locs +default+)
+                         (destructuring-bind (filename2 line2 col2) 
+                             (gethash n2 locs +default+)
+                           (cond ((string-lessp filename1 filename2) t)
+                                 ((string-lessp filename2 filename1) nil)
+                                 ((< line1 line2) t)
+                                 ((> line1 line2) nil)
+                                 (t (< col1 col2)))))))))
+            locs)))
+
 (defun slime-alistify (list key test)
   "Partition the elements of LIST into an alist.
 KEY extracts the key from an element and TEST is used to compare
@@ -3168,19 +3167,20 @@
          (cond ((eq (car file) ':source-form) nil)
                ((eq (slime-note.severity note) :read-error)
                 (slime-choose-overlay-for-read-error location))
-               (t 
+               ((equal pos '(:eof))
+                (list (1- (point-max)) (point-max)))
+               (t
                 (slime-choose-overlay-for-sexp location))))))))
 
 (defun slime-choose-overlay-for-read-error (location)
   (let ((pos (slime-location-offset location)))
     (save-excursion
       (goto-char pos)
-      (let ((symbol (slime-symbol-at-point)))
-        (if symbol
-            ;; package not found, &c.
-            (values (slime-symbol-start-pos) (slime-symbol-end-pos))
-            ;; comma not inside backquote, unmatched right parenthesis, &c.
-            (values pos (1+ pos)))))))
+      (cond ((slime-symbol-at-point)
+             ;; package not found, &c.
+             (values (slime-symbol-start-pos) (slime-symbol-end-pos)))
+            (t
+             (values pos (1+ pos)))))))
           
 (defun slime-choose-overlay-for-sexp (location)
   (slime-goto-source-location location)
@@ -3199,14 +3199,18 @@
   (save-excursion (goto-char (min pos1 pos2))
                   (<= (max pos1 pos2) (line-end-position))))
 
+(defvar slime-severity-face-plist 
+  '(:error         slime-error-face
+    :read-error    slime-error-face
+    :warning       slime-warning-face
+    :redefinition  slime-style-warning-face
+    :style-warning slime-style-warning-face
+    :note          slime-note-face))
+
 (defun slime-severity-face (severity)
   "Return the name of the font-lock face representing SEVERITY."
-  (ecase severity
-    (:error         'slime-error-face)
-    (:read-error    'slime-error-face)
-    (:warning       'slime-warning-face)
-    (:style-warning 'slime-style-warning-face)
-    (:note          'slime-note-face)))
+  (or (plist-get slime-severity-face-plist severity)
+      (error "No face for: %S" severity)))
 
 (defvar slime-severity-order 
   '(:note :style-warning :redefinition :warning :error :read-error))
@@ -3665,12 +3669,10 @@
 visible, and to highlight any further notes that are nested inside the
 current one.
 
-The highlighting is automatically undone before the next Emacs command."
-  (lexical-let ((old-face (overlay-get overlay 'face))
-                (overlay overlay))
-    (push (lambda () (overlay-put overlay 'face old-face))
-	  slime-pre-command-actions)
-    (overlay-put overlay 'face 'slime-highlight-face)))
+The highlighting is automatically undone with a timer."
+  (run-with-timer 0.2 nil
+                  #'overlay-put overlay 'face (overlay-get overlay 'face))
+  (overlay-put overlay 'face 'slime-highlight-face))
 
 
 ;;;;; Overlay lookup operations
@@ -5773,14 +5775,16 @@
 
 (defun slime-show-buffer-position (position &optional recenter)
   "Ensure sure that the POSITION in the current buffer is visible."
-  (let ((window (display-buffer (current-buffer) t t)))
+  (let ((window (display-buffer (current-buffer) t)))
     (save-selected-window
       (select-window window)
       (goto-char position)
-      (unless (pos-visible-in-window-p)
-        (reposition-window))
-      (cond ((eq recenter 'top)    (recenter 0))
-            ((eq recenter 'center) (recenter))))))
+      (ecase recenter
+        (top (recenter 0))
+        (center (recenter))
+        ((nil)
+         (unless (pos-visible-in-window-p)
+           (reposition-window)))))))
 
 (defun sldb-recenter-region (start end &optional center)
   "Make the region from START to END visible.




From heller at common-lisp.net  Sat Aug 15 08:34:56 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 15 Aug 2009 04:34:56 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1McEj2-0000G8-2x@common-lisp.net>

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

Modified Files:
	ChangeLog swank-ccl.lisp 
Log Message:
* swank-ccl.lisp (definition-name): Special case methods.

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/15 08:34:48	1.1835
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/15 08:34:55	1.1836
@@ -10,6 +10,8 @@
 
 2009-08-15  Helmut Eller  <heller at common-lisp.net>
 
+	* swank-ccl.lisp (definition-name): Special case methods.
+
 	* slime.el (slime-choose-overlay-region): Don't return zero length
 	regions for :eof.
 	(slime-show-buffer-position): The second argument to
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2009/08/10 19:30:22	1.3
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2009/08/15 08:34:56	1.4
@@ -617,7 +617,9 @@
        (lambda () "No source note available")))))
 
 (defun definition-name (type object)
-  (list (ccl:definition-type-name type) (ccl:name-of object)))
+  (case (ccl:definition-type-name type)
+    (method (ccl:name-of object))
+    (t (list (ccl:definition-type-name type) (ccl:name-of object)))))
 
 ;;; Utilities
 




From heller at common-lisp.net  Sat Aug 15 08:35:00 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 15 Aug 2009 04:35:00 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1McEj6-0000Gl-HP@common-lisp.net>

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

Modified Files:
	ChangeLog slime-autodoc.el slime-fancy.el 
Log Message:
Disable slime-autodoc for XEmacs.

* slime-autodoc.el, slime-fancy.el: XEmacs's version of eldoc
doesn't have the neccessary hooks.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/11 17:08:21	1.232
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/15 08:35:00	1.233
@@ -3,11 +3,18 @@
 	* slime-autodoc.el (slime-arglist): Pass properly formed argument
 	in the rpc call.
 
+2009-08-15  Helmut Eller  <heller at common-lisp.net>
+
+	Disable slime-autodoc for XEmacs.
+
+	* slime-autodoc.el, slime-fancy.el: XEmacs's version of eldoc
+	doesn't have the neccessary hooks.
+
 2009-08-09  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-fuzzy.el (slime-fuzzy-complete-symbol): change
-	`comint-completion-addsuffix' to not add space after completing
-	a filename.
+	`comint-completion-addsuffix' to not add space after completing a
+	filename.
 
 2009-08-05  Stas Boukarev  <stassats at gmail.com>
 
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/08/11 17:08:21	1.17
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/08/15 08:35:00	1.18
@@ -16,6 +16,10 @@
 ;;   (add-hook 'slime-load-hook (lambda () (require 'slime-autodoc)))
 ;;
 
+(eval-and-compile
+  (assert (not (featurep 'xemacs)) ()
+	  "slime-autodoc doesn't work with XEmacs"))
+
 (require 'slime-parse)
 (require 'slime-enclosing-context)
 
@@ -229,7 +233,6 @@
     (save-match-data
       (slime-compute-autodoc-internal))))
 
-
 (make-variable-buffer-local (defvar slime-autodoc-mode nil))
 
 (defun slime-autodoc-mode (&optional arg)
@@ -238,14 +241,14 @@
   (make-local-variable 'eldoc-idle-delay)
   (setq eldoc-documentation-function 'slime-compute-autodoc)
   (setq eldoc-idle-delay slime-autodoc-delay)
-  (if (eldoc-mode arg)
-      (progn 
-        (setq slime-echo-arglist-function 
-              #'(lambda () (eldoc-message (slime-compute-autodoc))))
-        (setq slime-autodoc-mode t))
-      (progn 
-        (setq slime-echo-arglist-function 'slime-show-arglist)
-        (setq slime-autodoc-mode nil))))
+  (eldoc-mode arg)
+  (cond (eldoc-mode
+	 (setq slime-echo-arglist-function 
+	       (lambda () (eldoc-message (slime-compute-autodoc))))
+	 (setq slime-autodoc-mode t))
+	(t
+	 (setq slime-echo-arglist-function 'slime-show-arglist)
+	 (setq slime-autodoc-mode nil))))
 
 (defadvice eldoc-display-message-no-interference-p 
     (after slime-autodoc-message-ok-p)
--- /project/slime/cvsroot/slime/contrib/slime-fancy.el	2008/12/24 08:13:43	1.8
+++ /project/slime/cvsroot/slime/contrib/slime-fancy.el	2009/08/15 08:35:00	1.9
@@ -21,8 +21,9 @@
 (slime-repl-init)
 
 ;; Better arglist display, can be turned off by customization.
-(require 'slime-autodoc)
-(slime-autodoc-init)
+(unless (featurep 'xemacs)
+  (require 'slime-autodoc)
+  (slime-autodoc-init))
 
 ;; Adds new commands and installs compound-prefix-completion as
 ;; default completion command.  Behaves similar to standard Emacs




From heller at common-lisp.net  Sat Aug 15 08:35:04 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 15 Aug 2009 04:35:04 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1McEjA-0000HV-MH@common-lisp.net>

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

Modified Files:
	ChangeLog slime-typeout-frame.el 
Log Message:
* slime-typeout-frame.el (slime-typeout-message): Don't call
slime-autodoc-stop-timer which no longer exists since 2009-01-01.
(slime-typeout-frame-init): Don't create a frame in a tty-only
session.
(slime-typeout-tty-only-p): New predicate.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/15 08:35:00	1.233
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/15 08:35:04	1.234
@@ -5,6 +5,14 @@
 
 2009-08-15  Helmut Eller  <heller at common-lisp.net>
 
+	* slime-typeout-frame.el (slime-typeout-message): Don't call
+	slime-autodoc-stop-timer which no longer exists since 2009-01-01.
+	(slime-typeout-frame-init): Don't create a frame in a tty-only
+	session.
+	(slime-typeout-tty-only-p): New predicate.
+
+2009-08-15  Helmut Eller  <heller at common-lisp.net>
+
 	Disable slime-autodoc for XEmacs.
 
 	* slime-autodoc.el, slime-fancy.el: XEmacs's version of eldoc
--- /project/slime/cvsroot/slime/contrib/slime-typeout-frame.el	2008/08/05 18:19:34	1.7
+++ /project/slime/cvsroot/slime/contrib/slime-typeout-frame.el	2009/08/15 08:35:04	1.8
@@ -42,12 +42,7 @@
 	(insert msg)))))
 
 (defun slime-typeout-message (format-string &rest format-args)
-  (apply #'slime-typeout-message-aux format-string format-args)
-  ;; Disable the timer for autodoc temporarily, as it would overwrite
-  ;; the current typeout message otherwise.
-  (when (and (featurep 'slime-autodoc) slime-autodoc-mode)
-    (slime-autodoc-stop-timer)
-    (add-hook 'pre-command-hook #'slime-autodoc-start-timer)))
+  (apply #'slime-typeout-message-aux format-string format-args))
 
 (defun slime-make-typeout-frame ()
   "Create a frame for displaying messages (e.g. arglists)."
@@ -69,6 +64,7 @@
 
 (defun slime-typeout-autodoc-message (doc)
   ;; No need for refreshing per `slime-autodoc-pre-command-refresh-echo-area'.
+  ;; FIXME: eldoc doesn't know anything about this
   (setq slime-autodoc-last-message "")
   (slime-typeout-message-aux "%s" doc))
 
@@ -84,19 +80,26 @@
 (defvar slime-typeout-frame-unbind-stack ())
 
 (defun slime-typeout-frame-init ()
-  (add-hook 'slime-connected-hook 'slime-ensure-typeout-frame)
-  (loop for (var value) in 
-	'((slime-message-function slime-typeout-message)
-	  (slime-background-message-function slime-typeout-message)
-	  (slime-autodoc-message-function slime-typeout-autodoc-message)
-	  (slime-autodoc-dimensions-function slime-typeout-autodoc-dimensions))
-	do (slime-typeout-frame-init-var var value)))
+  (unless (slime-typeout-tty-only-p)
+    (add-hook 'slime-connected-hook 'slime-ensure-typeout-frame)
+    (loop for (var value) in 
+	  '((slime-message-function slime-typeout-message)
+	    (slime-background-message-function slime-typeout-message)
+	    (slime-autodoc-message-function slime-typeout-autodoc-message)
+	    (slime-autodoc-dimensions-function
+	     slime-typeout-autodoc-dimensions))
+	  do (slime-typeout-frame-init-var var value))))
 
 (defun slime-typeout-frame-init-var (var value)
   (push (list var (if (boundp var) (symbol-value var) 'slime-unbound))
 	slime-typeout-frame-unbind-stack)
   (set var value))
 
+(defun slime-typeout-tty-only-p ()
+  (cond ((featurep 'xemacs)
+	 (null (remove 'tty (mapcar #'device-type (console-device-list)))))
+	(t (not (window-system)))))
+
 (defun slime-typeout-frame-unload ()
   (remove-hook 'slime-connected-hook 'slime-ensure-typeout-frame)
   (loop for (var value) in slime-typeout-frame-unbind-stack 




From heller at common-lisp.net  Sat Aug 15 08:35:08 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 15 Aug 2009 04:35:08 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1McEjE-0000IA-NX@common-lisp.net>

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

Modified Files:
	swank-kawa.scm 
Log Message:
* swank-kawa.scm: Internal API for javap changed in JDK1.7. Disable it.

--- /project/slime/cvsroot/slime/contrib/swank-kawa.scm	2009/07/21 11:02:42	1.18
+++ /project/slime/cvsroot/slime/contrib/swank-kawa.scm	2009/08/15 08:35:08	1.19
@@ -572,7 +572,7 @@
   (log "listener: ~s ~s ~s ~s\n" 
        (current-thread) ((current-thread):hashCode) c env)
   (let ((out (make-swank-outport (rpc c `(get-channel)))))
-    (set (current-output-port) out)
+    ;;(set (current-output-port) out)
     (let ((vm (as <vm> (rpc c `(get-vm)))))
       (send c `(set-listener ,(vm-mirror vm (current-thread))))
       (enable-uncaught-exception-events vm))
@@ -644,18 +644,18 @@
 
 (defslimefun compile-file-for-emacs (env (filename <str>) load? 
                                          #!optional options)
-  (let ((zip (cat (path-sans-extension (filepath filename)) ".zip")))
+  (let ((jar (cat (path-sans-extension (filepath filename)) ".jar")))
     (wrap-compilation 
      (fun ((m <gnu.text.SourceMessages>))
        (kawa.lang.CompileFile:read filename m))
-     zip (if (lisp-bool load?) env #f) #f)))
+     jar (if (lisp-bool load?) env #f) #f)))
 
-(df wrap-compilation (f zip env delete?)
+(df wrap-compilation (f jar env delete?)
   (let ((start-time (current-time))
         (messages (<gnu.text.SourceMessages>)))
     (try-catch
      (let ((c (as <gnu.expr.Compilation> (f messages))))
-       (! compile-to-archive c (! get-module c) zip))
+       (! compile-to-archive c (! get-module c) jar))
      (ex <throwable>
          (log "error during compilation: ~a\n" ex)
          (! error messages (as <char> #\f)
@@ -664,10 +664,10 @@
     (let ((success? (zero? (! get-error-count messages))))
       (when (and env success?)
         (log "loading ...\n")
-        (eval `(load ,zip) env)
+        (eval `(load ,jar) env)
         (log "loading ... done.\n"))
       (when delete?
-        (ignore-errors (delete-file zip)))
+        (ignore-errors (delete-file jar)))
       (let ((end-time (current-time)))
         (list ':compilation-result 
               (compiler-notes-for-emacs messages)
@@ -768,6 +768,9 @@
 (defslimefun quit-lisp (env)
   (exit))
 
+;;(defslimefun set-default-directory (env newdir))
+
+
 ;;;; Dummy defs
 
 
@@ -2036,31 +2039,31 @@
     (format #t "; Heap~1,16t: ~10:d\n" heap)
     (format #t "; Non-Heap~1,16t: ~10:d\n" nheap)))
 
-(df javap (class #!key method signature)
-  (let* ((<is> <java.io.ByteArrayInputStream>)
-         (bytes
-          (typecase class
-            (<string> (read-bytes (<java.io.FileInputStream> (to-str class))))
-            (<byte[]> class)
-            (<symbol> (read-class-file class))))
-         (cdata (<sun.tools.javap.ClassData> (<is> bytes)))
-         (p (<sun.tools.javap.JavapPrinter> 
-	     (<is> bytes)
-             (current-output-port)
-             (<sun.tools.javap.JavapEnvironment>))))
-    (cond (method
-           (dolist ((m <sun.tools.javap.MethodData>)
-                    (array-to-list (! getMethods cdata)))
-             (when (and (equal (to-str method) (! getName m))
-                        (or (not signature) 
-                            (equal signature (! getInternalSig m))))
-               (! printMethodSignature p m (! getAccess m))
-               (! printExceptions p m)
-               (newline)
-               (! printVerboseHeader p m)
-               (! printcodeSequence p m))))
-          (#t (p:print)))
-    (values)))
+;; (df javap (class #!key method signature)
+;;   (let* ((<is> <java.io.ByteArrayInputStream>)
+;;          (bytes
+;;           (typecase class
+;;             (<string> (read-bytes (<java.io.FileInputStream> (to-str class))))
+;;             (<byte[]> class)
+;;             (<symbol> (read-class-file class))))
+;;          (cdata (<sun.tools.javap.ClassData> (<is> bytes)))
+;;          (p (<sun.tools.javap.JavapPrinter> 
+;; 	     (<is> bytes)
+;;              (current-output-port)
+;;              (<sun.tools.javap.JavapEnvironment>))))
+;;     (cond (method
+;;            (dolist ((m <sun.tools.javap.MethodData>)
+;;                     (array-to-list (! getMethods cdata)))
+;;              (when (and (equal (to-str method) (! getName m))
+;;                         (or (not signature) 
+;;                             (equal signature (! getInternalSig m))))
+;;                (! printMethodSignature p m (! getAccess m))
+;;                (! printExceptions p m)
+;;                (newline)
+;;                (! printVerboseHeader p m)
+;;                (! printcodeSequence p m))))
+;;           (#t (p:print)))
+;;     (values)))
 
 (df read-bytes ((is <java.io.InputStream>) => <byte[]>)
   (let ((os (<java.io.ByteArrayOutputStream>)))




From heller at common-lisp.net  Sat Aug 15 08:35:15 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 15 Aug 2009 04:35:15 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1McEjL-0000Ik-4v@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/15 08:34:55	1.1836
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/15 08:35:15	1.1837
@@ -1,13 +1,3 @@
-2009-08-13  Stas Boukarev  <stassats at gmail.com>
-
-	* slime.el (slime-auto-select-connection, slime-auto-connect):
-	Turn them into customizable variables.
-
-2009-08-11  Tobias C. Rittweiler  <tcr at freebits.de>
-
-	* swank-sbcl.lisp (swank-compile-string): Make sure that it
-	returns NIL on compilation failure.
-
 2009-08-15  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-ccl.lisp (definition-name): Special case methods.
@@ -21,6 +11,16 @@
 	(slime-temporarily-highlight-note): Use a timer instead of the
 	post-command-hook.
 
+2009-08-13  Stas Boukarev  <stassats at gmail.com>
+
+	* slime.el (slime-auto-select-connection, slime-auto-connect):
+	Turn them into customizable variables.
+
+2009-08-11  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-sbcl.lisp (swank-compile-string): Make sure that it
+	returns NIL on compilation failure.
+
 2009-08-10  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-insert-note-group): Factored out from




From heller at common-lisp.net  Sat Aug 15 08:39:10 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 15 Aug 2009 04:39:10 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1McEn8-0000VQ-LZ@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/15 08:35:04	1.234
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/15 08:39:10	1.235
@@ -1,8 +1,3 @@
-2009-08-11  Tobias C. Rittweiler  <tcr at freebits.de>
-
-	* slime-autodoc.el (slime-arglist): Pass properly formed argument
-	in the rpc call.
-
 2009-08-15  Helmut Eller  <heller at common-lisp.net>
 
 	* slime-typeout-frame.el (slime-typeout-message): Don't call
@@ -18,6 +13,11 @@
 	* slime-autodoc.el, slime-fancy.el: XEmacs's version of eldoc
 	doesn't have the neccessary hooks.
 
+2009-08-11  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-autodoc.el (slime-arglist): Pass properly formed argument
+	in the rpc call.
+
 2009-08-09  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-fuzzy.el (slime-fuzzy-complete-symbol): change




From heller at common-lisp.net  Sat Aug 15 16:01:18 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sat, 15 Aug 2009 12:01:18 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1McLh0-0000M7-8r@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
XEmacs fixes.

* slime.el (slime-editing-keys): Use (kbd "C-M-.") because XEmacs
translates [?\C-\M-.] to C-M-n.
(next-single-char-property-change)
(previous-single-char-property-change): Use
next-single-property-change because next-char-property-change gets
embarrisingly slow in XEmacs in font-locked buffers.
It never felt that slow in Emacs 20 though.

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/15 08:35:15	1.1837
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/15 16:01:17	1.1838
@@ -1,5 +1,17 @@
 2009-08-15  Helmut Eller  <heller at common-lisp.net>
 
+	XEmacs fixes.
+
+	* slime.el (slime-editing-keys): Use (kbd "C-M-.") because XEmacs
+	translates [?\C-\M-.] to C-M-n.
+	(next-single-char-property-change)
+	(previous-single-char-property-change): Use
+	next-single-property-change because next-char-property-change gets
+	embarrisingly slow in XEmacs in font-locked buffers.
+	It never felt that slow in Emacs 20 though.
+
+2009-08-15  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-ccl.lisp (definition-name): Special case methods.
 
 	* slime.el (slime-choose-overlay-region): Don't return zero length
--- /project/slime/cvsroot/slime/slime.el	2009/08/15 08:34:48	1.1213
+++ /project/slime/cvsroot/slime/slime.el	2009/08/15 16:01:17	1.1214
@@ -571,7 +571,7 @@
 ;;; These keys are useful for buffers where the user can insert and
 ;;; edit s-exprs, e.g. for source buffers and the REPL.
 (defvar slime-editing-keys
-  '(;; Arglist display & completion
+  `(;; Arglist display & completion
     ("\M-\t"      slime-complete-symbol)
     (" "          slime-space)
     ;; Evaluating
@@ -582,7 +582,7 @@
     ("\C-c\M-m"   slime-macroexpand-all)
     ;; Misc
     ("\C-c\C-u"   slime-undefine-function)
-    ([?\C-\M-.]   slime-next-location)
+    (,(kbd "C-M-.")   slime-next-location)
     ;; Obsolete, redundant bindings
     ("\C-c\C-i" slime-complete-symbol)
     ;;("\M-*" pop-tag-mark) ; almost to clever
@@ -8652,7 +8652,8 @@
       (with-current-buffer (or object (current-buffer))
 	(let ((initial-value (get-char-property position prop object))
 	      (limit (or limit (point-max))))
-	  (loop for pos = position then (next-char-property-change pos limit)
+	  (loop for pos = position then 
+                (next-single-property-change pos prop object limit)
 		if (>= pos limit) return limit
 		if (not (eq initial-value 
 			    (get-char-property pos prop object))) 
@@ -8675,7 +8676,7 @@
             (let ((initial-value (get-char-property (1- position)
                                                     prop object)))
               (loop for pos = position then 
-                    (previous-char-property-change pos limit)
+                    (previous-single-property-change pos prop object limit)
                     if (<= pos limit) return limit
                     if (not (eq initial-value 
                                 (get-char-property (1- pos) prop object))) 




From heller at common-lisp.net  Sun Aug 16 20:00:09 2009
From: heller at common-lisp.net (CVS User heller)
Date: Sun, 16 Aug 2009 16:00:09 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1Mclth-00019h-NS@common-lisp.net>

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (init-global-stream-redirection): Continue even if
streams are already redirected.  Useful for restarting Swank with
M-x slime when a REPL is already present.  Will most likeley
mess up the input stream in multi threaded setups, tho.

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/15 16:01:17	1.1838
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/16 20:00:09	1.1839
@@ -1,3 +1,10 @@
+2009-08-16  StanisBaw Halik <sthalik at test123.ltd.pl>
+
+	* swank.lisp (init-global-stream-redirection): Continue even if
+	streams are already redirected.  Useful for restarting Swank with
+	M-x slime when a REPL is already present.  Will most likeley
+	mess up the input stream in multi threaded setups, tho.
+
 2009-08-15  Helmut Eller  <heller at common-lisp.net>
 
 	XEmacs fixes.
--- /project/slime/cvsroot/slime/swank.lisp	2009/08/10 19:30:22	1.657
+++ /project/slime/cvsroot/slime/swank.lisp	2009/08/16 20:00:09	1.658
@@ -1489,11 +1489,13 @@
 
 (defun init-global-stream-redirection ()
   (when *globally-redirect-io*
-    (assert (not *saved-global-streams*) () "Streams already redirected.")
-    (mapc #'setup-stream-indirection
-          (append *standard-output-streams*
-                  *standard-input-streams*
-                  *standard-io-streams*))))
+    (cond (*saved-global-streams*
+           (warn "Streams already redirected."))
+          (t
+           (mapc #'setup-stream-indirection
+                 (append *standard-output-streams*
+                         *standard-input-streams*
+                         *standard-io-streams*))))))
 
 (add-hook *after-init-hook* 'init-global-stream-redirection)
 




From mevenson at common-lisp.net  Tue Aug 18 09:51:12 2009
From: mevenson at common-lisp.net (CVS User mevenson)
Date: Tue, 18 Aug 2009 05:51:12 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MdLLU-0002Au-E0@common-lisp.net>

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

Modified Files:
	swank-abcl.lisp ChangeLog 
Log Message:
Restore working operation with abcl-0.15.


--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/06/21 07:22:56	1.65
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/08/18 09:51:12	1.66
@@ -567,11 +567,3 @@
 
 (defimplementation quit-lisp ()
   (ext:exit))
-
-;; WORKAROUND: call/initialize accessors at load time
-(let ((c (make-condition 'compiler-condition 
-                          :original-condition nil
-                          :severity ':note :message "" :location nil))
-       (slots `(severity message short-message references location)))
-   (dolist (slot slots)
-     (funcall slot c)))
--- /project/slime/cvsroot/slime/ChangeLog	2009/08/16 20:00:09	1.1839
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/18 09:51:12	1.1840
@@ -1,3 +1,11 @@
+2009-08-18  Mark Evenson  <evenson at panix.com>
+
+	Restore working with abcl-0.15.
+
+	* swank-abcl.lisp: Remove the warm initialization code for
+	SWANK:COMPILER-CONDITION, as it is no longer needed for the
+	current release of ABCL. 
+
 2009-08-16  StanisBaw Halik <sthalik at test123.ltd.pl>
 
 	* swank.lisp (init-global-stream-redirection): Continue even if




From mevenson at common-lisp.net  Tue Aug 18 10:42:08 2009
From: mevenson at common-lisp.net (CVS User mevenson)
Date: Tue, 18 Aug 2009 06:42:08 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MdM8m-0005we-62@common-lisp.net>

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

Modified Files:
	ChangeLog swank-abcl.lisp 
Log Message:
Add multithreading code for abcl-0.16. (Tobias Rittweiler)
 
  * swank-abcl.lisp: A multithread implementation taking advantage
    		     of the new synchronization primitives in abcl-0.16.  


--- /project/slime/cvsroot/slime/ChangeLog	2009/08/18 09:51:12	1.1840
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/18 10:42:07	1.1841
@@ -1,5 +1,10 @@
 2009-08-18  Mark Evenson  <evenson at panix.com>
 
+	Add multithreading code for abcl-0.16. (Tobias Rittweiler)
+
+	* swank-abcl.lisp: A multithread implementation taking advantage
+	of the new synchronization primitives in abcl-0.16.  
+
 	Restore working with abcl-0.15.
 
 	* swank-abcl.lisp: Remove the warm initialization code for
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/08/18 09:51:12	1.66
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/08/18 10:42:07	1.67
@@ -119,7 +119,11 @@
 
 
 (defimplementation preferred-communication-style ()
-  nil)
+#+#.(cl:if (cl:find-package :threads) '(:and) '(:or))
+  :spawn
+#-#.(cl:if (cl:find-package :threads) '(:and) '(:or))
+  nil
+)
 
 (defimplementation create-socket (host port)
   (ext:make-server-socket port))
@@ -483,87 +487,97 @@
 
 ;;;; Multithreading
 
-(defimplementation startup-multiprocessing ()
-  #+nil(mp:start-scheduler))
-
-(defimplementation spawn (fn &key name)
-  (ext:make-thread (lambda () (funcall fn)) :name name))
-
-(defvar *thread-props-lock* (ext:make-thread-lock))
-
-(defvar *thread-props* (make-hash-table) ; should be a weak table
-  "A hashtable mapping threads to a plist.")
-
-(defvar *thread-id-counter* 0)
-
-(defimplementation thread-id (thread)
-  (ext:with-thread-lock (*thread-props-lock*)
-    (or (getf (gethash thread *thread-props*) 'id)
-        (setf (getf (gethash thread *thread-props*) 'id)
+#+#.(cl:if (cl:find-package :threads) '(:and) '(:or))
+(progn
+  (defimplementation spawn (fn &key name)
+    (threads:make-thread (lambda () (funcall fn)) :name name))
+
+  (defvar *thread-plists* (make-hash-table) ; should be a weak table
+    "A hashtable mapping threads to a plist.")
+
+  (defvar *thread-id-counter* 0)
+
+  (defimplementation thread-id (thread)
+    (threads:synchronized-on *thread-plists*
+      (or (getf (gethash thread *thread-plists*) 'id)
+          (setf (getf (gethash thread *thread-plists*) 'id)
               (incf *thread-id-counter*)))))
 
-(defimplementation find-thread (id)
-  (find id (all-threads) 
+  (defimplementation find-thread (id)
+    (find id (all-threads) 
         :key (lambda (thread)
-                (getf (gethash thread *thread-props*) 'id))))
+                (getf (gethash thread *thread-plists*) 'id))))
 
-(defimplementation thread-name (thread)
-  (ext:thread-name thread))
+  (defimplementation thread-name (thread)
+    (threads:thread-name thread))
 
-(defimplementation thread-status (thread)
-  (format nil "Thread is ~:[dead~;alive~]" (ext:thread-alive-p thread)))
+  (defimplementation thread-status (thread)
+    (format nil "Thread is ~:[dead~;alive~]" (threads:thread-alive-p thread)))
 
-(defimplementation make-lock (&key name)
-  (ext:make-thread-lock))
-
-(defimplementation call-with-lock-held (lock function)
-  (ext:with-thread-lock (lock) (funcall function)))
-
-(defimplementation current-thread ()
-  (ext:current-thread))
-
-(defimplementation all-threads ()
-  (copy-list (ext:mapcar-threads #'identity)))
-
-(defimplementation interrupt-thread (thread fn)
-  (ext:interrupt-thread thread fn))
-
-(defimplementation kill-thread (thread)
-  (ext:destroy-thread thread))
-
-(defstruct mailbox 
-  (mutex (ext:make-mutex))
-  (queue '()))
-
-(defun mailbox (thread)
-  "Return THREAD's mailbox."
-  (ext:with-thread-lock (*thread-props-lock*)
-    (or (getf (gethash thread *thread-props*) 'mailbox)
-        (setf (getf (gethash thread *thread-props*) 'mailbox)
-              (make-mailbox)))))
-
-(defimplementation send (thread object)
-  (let ((mbox (mailbox thread)))
-    (ext:with-mutex ((mailbox-mutex mbox))
-      (setf (mailbox-queue mbox) 
-            (nconc (mailbox-queue mbox) (list message))))))
-
-#+(or)
-(defimplementation receive-if (thread &optional timeout)
-  (let* ((mbox (mailbox (current-thread))))
-    (assert (or (not timeout) (eq timeout t)))
-    (loop
-     (check-slime-interrupts)
-     (ext:with-mutex ((mailbox-mutex mbox))
-       (let* ((q (mailbox-queue mbox))
-              (tail (member-if test q)))
-         (when tail 
-           (setf (mailbox-queue mbox) (nconc (ldiff q tail) (cdr tail)))
-           (return (car tail))))
-       (when (eq timeout t) (return (values nil t)))
-       ;;(java:jcall (java:jmethod "java.lang.Object" "wait") 
-       ;;            (mailbox-mutex mbox) 1000)
-       ))))
+  ;; XXX should be a weak hash table
+  (defparameter *thread-description-map* (make-hash-table)) 
+
+  (defimplementation thread-description (thread) 
+    (synchronized-on *thread-description-map*
+      (or (gethash thread *thread-description-map*)
+          "No description available.")))
+
+  (defimplementation set-thread-description (thread description) 
+    (synchronized-on *thread-description-map*
+      (setf (gethash thread *thread-description-map*) description)))
+
+  (defimplementation make-lock (&key name)
+    (declare (ignore name))
+    (threads:make-thread-lock))
+
+  (defimplementation call-with-lock-held (lock function)
+    (threads:with-thread-lock (lock) (funcall function)))
+
+  (defimplementation current-thread ()
+    (threads:current-thread))
+
+  (defimplementation all-threads ()
+    (copy-list (threads:mapcar-threads #'identity)))
+
+  (defimplementation thread-alive-p (thread)
+    (member thread (all-threads)))
+
+  (defimplementation interrupt-thread (thread fn)
+    (threads:interrupt-thread thread fn)) 
+
+  (defimplementation kill-thread (thread)
+    (threads:destroy-thread thread))
+
+  (defstruct mailbox 
+    (queue '()))
+
+  (defun mailbox (thread)
+    "Return THREAD's mailbox."
+    (threads:synchronized-on *thread-plists*
+      (or (getf (gethash thread *thread-plists*) 'mailbox)
+          (setf (getf (gethash thread *thread-plists*) 'mailbox)
+                (make-mailbox)))))
+
+  (defimplementation send (thread message)
+    (let ((mbox (mailbox thread)))
+      (threads:synchronized-on mbox
+        (setf (mailbox-queue mbox) 
+              (nconc (mailbox-queue mbox) (list message)))
+        (threads:object-notify-all mbox))))
+
+  (defimplementation receive-if (test &optional timeout)
+    (let* ((mbox (mailbox (current-thread))))
+      (assert (or (not timeout) (eq timeout t)))
+      (loop
+       (check-slime-interrupts)
+       (threads:synchronized-on mbox
+         (let* ((q (mailbox-queue mbox))
+                (tail (member-if test q)))
+           (when tail 
+             (setf (mailbox-queue mbox) (nconc (ldiff q tail) (cdr tail)))
+               (return (car tail)))
+         (when (eq timeout t) (return (values nil t)))
+         (threads:object-wait mbox 0.3)))))))
 
 (defimplementation quit-lisp ()
   (ext:exit))




From mevenson at common-lisp.net  Wed Aug 19 14:58:02 2009
From: mevenson at common-lisp.net (CVS User mevenson)
Date: Wed, 19 Aug 2009 10:58:02 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1Mdmby-0007v4-CS@common-lisp.net>

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

Modified Files:
	swank-abcl.lisp ChangeLog 
Log Message:
* swank-abcl.lisp: Accommodate the new Java/Lisp stack frame
  		   abstraction in the upcoming abcl-0.16. (based on
  		   code from Tobias Rittweiler).


--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/08/18 10:42:07	1.67
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/08/19 14:58:02	1.68
@@ -16,7 +16,12 @@
 
 (defun sys::break (&optional (format-control "BREAK called") 
                    &rest format-arguments)
-  (let ((*saved-backtrace* (backtrace-as-list-ignoring-swank-calls)))
+  (let ((*saved-backtrace* 
+         #+#.(swank-backend::with-symbol 'backtrace 'sys) 
+         (sys:backtrace)
+         #-#.(swank-backend::with-symbol 'backtrace 'sys)
+         (ext:backtrace-as-list)
+         ))
     (with-simple-restart (continue "Return from BREAK.")
       (invoke-debugger
        (sys::%make-condition 'simple-condition
@@ -260,26 +265,45 @@
 
 (defvar *sldb-topframe*)
 
-(defun backtrace-as-list-ignoring-swank-calls ()
-  (let ((list (ext:backtrace-as-list)))
-    (subseq list (1+ (or (position (intern "SWANK-DEBUGGER-HOOK" 'swank) list :key 'car) -1)))))
-
 (defimplementation call-with-debugging-environment (debugger-loop-fn)
-  (let ((*sldb-topframe* (car (backtrace-as-list-ignoring-swank-calls)) #+nil (excl::int-newest-frame)))
+  (let* ((magic-token (intern "SWANK-DEBUGGER-HOOK" 'swank))
+         (*sldb-topframe* 
+          #+#.(swank-backend::with-symbol 'backtrace 'sys)
+          (second (member magic-token (sys:backtrace)
+                          :key #'(lambda (frame) 
+                                   (first (sys:frame-to-list frame)))))
+          #-#.(swank-backend::with-symbol 'backtrace 'sys)
+          (second (member magic-token (ext:backtrace-as-list)
+                          :key #'(lambda (frame) 
+                                   (first frame))))
+          ))
     (funcall debugger-loop-fn)))
 
+(defun backtrace (start end)
+  "A backtrace without initial SWANK frames."
+  (let ((backtrace 
+         #+#.(swank-backend::with-symbol 'backtrace 'sys)
+         (sys:backtrace)
+         #-#.(swank-backend::with-symbol 'backtrace 'sys)
+         (ext:backtrace-as-list)
+         ))
+    (subseq (or (member *sldb-topframe* backtrace) backtrace)
+            start end)))
+
 (defun nth-frame (index)
-  (nth index (backtrace-as-list-ignoring-swank-calls)))
+  (nth index (backtrace 0 nil)))
 
 (defimplementation compute-backtrace (start end)
   (let ((end (or end most-positive-fixnum)))
-    (loop for f in (subseq (backtrace-as-list-ignoring-swank-calls) start end)
-          collect f)))
+    (backtrace start end)))
 
 (defimplementation print-frame (frame stream)
-  (write-string (string-trim '(#\space #\newline)
-                             (prin1-to-string frame))
-                stream))
+  (write-string 
+   #+#.(swank-backend::with-symbol 'backtrace 'sys)
+   (sys:frame-to-string frame)
+   #-#.(swank-backend::with-symbol 'backtrace 'sys)
+   (string-trim '(#\space #\newline) (prin1-to-string frame))
+   stream))
 
 (defimplementation frame-locals (index)
   `(,(list :name "??" :id 0 :value "??")))
--- /project/slime/cvsroot/slime/ChangeLog	2009/08/18 10:42:07	1.1841
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/19 14:58:02	1.1842
@@ -1,3 +1,9 @@
+2009-08-19  Mark Evenson  <evenson at panix.com>
+
+	* swank-abcl.lisp: Accommodate the new Java/Lisp stack frame
+	abstraction in the upcoming abcl-0.16. (based on code from Tobias
+	Rittweiler).
+	
 2009-08-18  Mark Evenson  <evenson at panix.com>
 
 	Add multithreading code for abcl-0.16. (Tobias Rittweiler)




From heller at common-lisp.net  Fri Aug 21 17:16:43 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 21 Aug 2009 13:16:43 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MeXjH-0007bo-DT@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-transcript-start-hook)
(slime-transcript-stop-hook): New hooks.
(slime-eval-with-transcript): Use them.
(slime-eval-with-transcript-cont): Deleted.

* inferior-slime.el (inferior-slime-show-transcript)
(inferior-slime-stop-transcript, inferior-slime-start-transcript):
New functions.
(inferior-slime-init): Install transcript hooks.

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/19 14:58:02	1.1842
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/21 17:16:42	1.1843
@@ -1,21 +1,28 @@
+2009-08-21  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-transcript-start-hook)
+	(slime-transcript-stop-hook): New hooks.
+	(slime-eval-with-transcript): Use them.
+	(slime-eval-with-transcript-cont): Deleted.
+
 2009-08-19  Mark Evenson  <evenson at panix.com>
 
 	* swank-abcl.lisp: Accommodate the new Java/Lisp stack frame
 	abstraction in the upcoming abcl-0.16. (based on code from Tobias
 	Rittweiler).
-	
+
 2009-08-18  Mark Evenson  <evenson at panix.com>
 
 	Add multithreading code for abcl-0.16. (Tobias Rittweiler)
 
 	* swank-abcl.lisp: A multithread implementation taking advantage
-	of the new synchronization primitives in abcl-0.16.  
+	of the new synchronization primitives in abcl-0.16.
 
 	Restore working with abcl-0.15.
 
 	* swank-abcl.lisp: Remove the warm initialization code for
 	SWANK:COMPILER-CONDITION, as it is no longer needed for the
-	current release of ABCL. 
+	current release of ABCL.
 
 2009-08-16  StanisBaw Halik <sthalik at test123.ltd.pl>
 
--- /project/slime/cvsroot/slime/slime.el	2009/08/15 16:01:17	1.1214
+++ /project/slime/cvsroot/slime/slime.el	2009/08/21 17:16:42	1.1215
@@ -4199,8 +4199,7 @@
 inserted in the current buffer."
   (interactive (list (slime-read-from-minibuffer "Slime Eval: ")))
   (cond ((not current-prefix-arg)
-         (slime-eval-with-transcript `(swank:interactive-eval ,string) 
-                                     string))
+         (slime-eval-with-transcript `(swank:interactive-eval ,string)))
         (t
          (slime-eval-print string))))
 
@@ -4214,42 +4213,21 @@
                       (destructuring-bind (output value) result
                         (insert output value)))))
 
-(defun slime-eval-with-transcript (form &optional msg no-popups cont)
-  "Eval FROM in Lisp.  Display output, if any, caused by the evaluation."
-  ;;(when msg (slime-insert-transcript-delimiter msg))
-  ;;(setq slime-repl-popup-on-output (not no-popups))
-  (setq cont (or cont #'slime-display-eval-result))
-  (slime-rex (cont (buffer (current-buffer))) (form)
-    ((:ok value) (slime-eval-with-transcript-cont t value cont buffer))
-    ((:abort) (slime-eval-with-transcript-cont nil nil nil buffer))))
-
-;;(defun slime-insert-transcript-delimiter (string)
-;;  (with-current-buffer (slime-output-buffer)
-;;    (save-excursion
-;;      (goto-char slime-repl-input-start-mark)
-;;      (unless (bolp) (insert-before-markers "\n"))
-;;      (slime-propertize-region '(slime-transcript-delimiter t)
-;;        (insert-before-markers
-;;         ";;;; " (subst-char-in-string ?\n ?\ 
-;;                                       (substring string 0 
-;;                                                  (min 60 (length string))))
-;;         " ...\n"))
-;;      (assert (= (point) slime-repl-input-start-mark))
-;;      (slime-mark-output-start))
-;;    (slime-repl-show-maximum-output)))
-
-(defun slime-eval-with-transcript-cont (ok result cont buffer)
-  (run-with-timer 0.2 nil (lambda ()
-                            ;;(setq slime-repl-popup-on-output nil)
-                            ))
-  ;;(with-current-buffer (slime-output-buffer)
-  ;;  (save-excursion (slime-repl-insert-prompt))
-  ;;  (slime-repl-show-maximum-output))
-  (cond ((not ok)
-         (message "Evaluation aborted."))
-        (t
-         (with-current-buffer buffer
-           (funcall cont result)))))
+(defvar slime-transcript-start-hook nil
+  "Hook run before start an evalution.")
+(defvar slime-transcript-stop-hook nil
+  "Hook run after finishing a evalution.")
+
+(defun slime-eval-with-transcript (form)
+  "Eval FROM in Lisp.  Display output, if any."
+  (run-hooks 'slime-transcript-start-hook)
+  (slime-rex () (form)
+    ((:ok value)
+     (run-hooks 'slime-transcript-stop-hook)
+     (slime-display-eval-result value))
+    ((:abort)
+     (run-hooks 'slime-transcript-stop-hook)
+     (message "Evaluation aborted."))))
         
 (defun slime-eval-describe (form)
   "Evaluate FORM in Lisp and display the result in a new buffer."
@@ -4257,8 +4235,7 @@
                                        (slime-current-package))))
 
 (defvar slime-description-autofocus nil
-  "If NIL (the default) Slime description buffers do not grab
-focus automatically.")
+  "If non-nil select description windows on display.")
 
 (defun slime-show-description (string package)
   ;; So we can have one description buffer open per connection. Useful




From heller at common-lisp.net  Fri Aug 21 17:16:43 2009
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 21 Aug 2009 13:16:43 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MeXjH-0007c1-Nm@common-lisp.net>

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

Modified Files:
	ChangeLog inferior-slime.el 
Log Message:
* slime.el (slime-transcript-start-hook)
(slime-transcript-stop-hook): New hooks.
(slime-eval-with-transcript): Use them.
(slime-eval-with-transcript-cont): Deleted.

* inferior-slime.el (inferior-slime-show-transcript)
(inferior-slime-stop-transcript, inferior-slime-start-transcript):
New functions.
(inferior-slime-init): Install transcript hooks.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/15 08:39:10	1.235
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/21 17:16:43	1.236
@@ -1,3 +1,10 @@
+2009-08-21  Helmut Eller  <heller at common-lisp.net>
+
+	* inferior-slime.el (inferior-slime-show-transcript)
+	(inferior-slime-stop-transcript, inferior-slime-start-transcript):
+	New functions.
+	(inferior-slime-init): Install transcript hooks.
+
 2009-08-15  Helmut Eller  <heller at common-lisp.net>
 
 	* slime-typeout-frame.el (slime-typeout-message): Don't call
--- /project/slime/cvsroot/slime/contrib/inferior-slime.el	2009/01/05 21:57:54	1.6
+++ /project/slime/cvsroot/slime/contrib/inferior-slime.el	2009/08/21 17:16:43	1.7
@@ -95,9 +95,30 @@
 (defun inferior-slime-switch-to-repl-buffer ()
   (switch-to-buffer (process-buffer (slime-inferior-process))))
 
+(defun inferior-slime-show-transcript (string)
+  (remove-hook 'comint-output-filter-functions
+	       'inferior-slime-show-transcript t)
+  (display-buffer (process-buffer (slime-inferior-process)) t))
+
+(defun inferior-slime-start-transcript ()
+  (with-current-buffer (process-buffer (slime-inferior-process))
+    (add-hook 'comint-output-filter-functions 
+	      'inferior-slime-show-transcript
+	      nil t)))
+
+(defun inferior-slime-stop-transcript ()
+  (run-with-timer 0.2 nil 
+		  (lambda (buffer) 
+		    (with-current-buffer buffer
+		      (remove-hook 'comint-output-filter-functions
+				   'inferior-slime-show-transcript t)))
+		  (current-buffer)))
+
 (defun inferior-slime-init ()
   (add-hook 'slime-inferior-process-start-hook 'inferior-slime-hook-function)
   (add-hook 'slime-change-directory-hooks 'inferior-slime-change-directory)
+  (add-hook 'slime-transcript-start-hook 'inferior-slime-start-transcript)
+  (add-hook 'slime-transcript-stop-hook 'inferior-slime-stop-transcript)
   (def-slime-selector-method ?r
     "SLIME Read-Eval-Print-Loop."
     (inferior-slime-switch-to-repl-buffer)))




From sboukarev at common-lisp.net  Thu Aug 27 14:48:46 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Thu, 27 Aug 2009 10:48:46 -0400
Subject: [slime-cvs] CVS slime/doc
Message-ID: <E1MggHO-0007Fa-KM@common-lisp.net>

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

Modified Files:
	slime.texi 
Log Message:
Fix typo. Thanks to Nick Levine.


--- /project/slime/cvsroot/slime/doc/slime.texi	2009/08/09 14:07:48	1.77
+++ /project/slime/cvsroot/slime/doc/slime.texi	2009/08/27 14:48:46	1.78
@@ -12,7 +12,7 @@
 @set EDITION 3.0-alpha
 @set SLIMEVER 3.0-alpha
 @c @set UPDATED @today{}
- at set UPDATED @code{$Date: 2009/08/09 14:07:48 $}
+ at set UPDATED @code{$Date: 2009/08/27 14:48:46 $}
 @set TITLE SLIME User Manual
 @settitle @value{TITLE}, version @value{EDITION}
 
@@ -293,7 +293,7 @@
 
 @SLIME{} supports a wide range of operating systems and Lisp
 implementations. @SLIME{} runs on Unix systems, Mac OSX, and Microsoft
-Windows. GNU Emacs versions 21, 22, and 22 and XEmacs version 21 are
+Windows. GNU Emacs versions 21, 22, and 23 and XEmacs version 21 are
 supported.
 
 The supported Lisp implementations, roughly ordered from the




From sboukarev at common-lisp.net  Thu Aug 27 15:24:31 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Thu, 27 Aug 2009 11:24:31 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1Mggpz-0001Xk-SG@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-remove-old-overlays): delete notes at the very beginning
of the buffer too. Thanks to Nick Levine.


--- /project/slime/cvsroot/slime/ChangeLog	2009/08/21 17:16:42	1.1843
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/27 15:24:31	1.1844
@@ -1,3 +1,8 @@
+2009-08-27  Stas Boukarev  <stassats at gmail.com>
+
+	* slime.el (slime-remove-old-overlays): delete notes at the very beginning
+	of the buffer too. Thanks to Nick Levine.
+
 2009-08-21  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-transcript-start-hook)
--- /project/slime/cvsroot/slime/slime.el	2009/08/21 17:16:42	1.1215
+++ /project/slime/cvsroot/slime/slime.el	2009/08/27 15:24:31	1.1216
@@ -2811,13 +2811,15 @@
 
 (defun slime-remove-old-overlays ()
   "Delete the existing Slime overlays in the current buffer."
-  (dolist (buffer (slime-filter-buffers (lambda () slime-mode)))
+  (dolist (buffer (slime-filter-buffers 'slime-mode))
     (with-current-buffer buffer
       (save-excursion
         (save-restriction
           (widen)                ; remove overlays within the whole buffer.
           (goto-char (point-min))
-          (let ((o))
+          (let ((o (slime-note-at-point)))
+            (when o
+              (delete-overlay o))
             (while (setq o (slime-find-next-note))
               (delete-overlay o))))))))
 




From sboukarev at common-lisp.net  Thu Aug 27 15:46:01 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Thu, 27 Aug 2009 11:46:01 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MghAn-00033l-61@common-lisp.net>

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

Modified Files:
	ChangeLog slime-c-p-c.el 
Log Message:
* slime-c-p-c.el (slime-contextual-completions): Detect characters properly.
(slime-completions-for-character): Append #\ to the character names.
This fixes character completion, reported by Nick Levine.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/21 17:16:43	1.236
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/27 15:46:01	1.237
@@ -1,3 +1,9 @@
+2009-08-27  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-c-p-c.el (slime-contextual-completions): Detect characters properly.
+	(slime-completions-for-character): Append #\ to the character names.
+	This fixes character completion, reported by Nick Levine.
+
 2009-08-21  Helmut Eller  <heller at common-lisp.net>
 
 	* inferior-slime.el (inferior-slime-show-transcript)
--- /project/slime/cvsroot/slime/contrib/slime-c-p-c.el	2009/02/27 17:37:14	1.10
+++ /project/slime/cvsroot/slime/contrib/slime-c-p-c.el	2009/08/27 15:46:01	1.11
@@ -127,8 +127,8 @@
             ;; If no matching keyword was found, do regular symbol
             ;; completion.
             ))))
-     ((and (> beg 2)
-           (string= (buffer-substring-no-properties (- beg 2) beg) "#\\"))
+     ((and (>= (length token) 2)
+           (string= (dbgmsg (subseq token 0 2)) "#\\"))
       ;; Character name completion
       (return-from slime-contextual-completions
         (slime-completions-for-character token))))
@@ -145,7 +145,12 @@
 					      ',arg-indices)))
 
 (defun slime-completions-for-character (prefix)
-  (slime-eval `(swank:completions-for-character ,prefix)))
+  (flet ((append-char-syntax (string) (concat "#\\" string)))
+    (let ((result (slime-eval `(swank:completions-for-character
+                                ,(subseq prefix 2)))))
+      (when (car result)
+        (list (mapcar 'append-char-syntax (car result))
+              (append-char-syntax (cadr result)))))))
 
 
 ;;; Complete form




From heller at common-lisp.net  Thu Aug 27 20:15:43 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 27 Aug 2009 16:15:43 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MglNn-0003BH-Ot@common-lisp.net>

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

Modified Files:
	ChangeLog inferior-slime.el 
Log Message:
* inferior-slime.el (inferior-slime-stop-transcript): Switch
to the right the buffer.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/27 15:46:01	1.237
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/27 20:15:43	1.238
@@ -4,6 +4,11 @@
 	(slime-completions-for-character): Append #\ to the character names.
 	This fixes character completion, reported by Nick Levine.
 
+2009-08-24  Helmut Eller  <heller at common-lisp.net>
+
+	* inferior-slime.el (inferior-slime-stop-transcript): Switch
+	to the right buffer.
+
 2009-08-21  Helmut Eller  <heller at common-lisp.net>
 
 	* inferior-slime.el (inferior-slime-show-transcript)
--- /project/slime/cvsroot/slime/contrib/inferior-slime.el	2009/08/21 17:16:43	1.7
+++ /project/slime/cvsroot/slime/contrib/inferior-slime.el	2009/08/27 20:15:43	1.8
@@ -107,12 +107,13 @@
 	      nil t)))
 
 (defun inferior-slime-stop-transcript ()
-  (run-with-timer 0.2 nil 
-		  (lambda (buffer) 
-		    (with-current-buffer buffer
-		      (remove-hook 'comint-output-filter-functions
-				   'inferior-slime-show-transcript t)))
-		  (current-buffer)))
+  (with-current-buffer (process-buffer (slime-inferior-process))
+    (run-with-timer 0.2 nil 
+		    (lambda (buffer) 
+		      (with-current-buffer buffer
+			(remove-hook 'comint-output-filter-functions
+				     'inferior-slime-show-transcript t)))
+		    (current-buffer))))
 
 (defun inferior-slime-init ()
   (add-hook 'slime-inferior-process-start-hook 'inferior-slime-hook-function)




From heller at common-lisp.net  Thu Aug 27 20:19:26 2009
From: heller at common-lisp.net (CVS User heller)
Date: Thu, 27 Aug 2009 16:19:26 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MglRO-0003IB-Cy@common-lisp.net>

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
Speed up symbol completion.

* swank.lisp (all-completions): Don't call unparse-symbol
while matching.  That gets very slow in CCL's CCL package.
Just use symbol-name and compare with char-equal.
(prefix-match-p): Use char-equal.

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/27 15:24:31	1.1844
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/27 20:19:26	1.1845
@@ -3,6 +3,15 @@
 	* slime.el (slime-remove-old-overlays): delete notes at the very beginning
 	of the buffer too. Thanks to Nick Levine.
 
+2009-08-22  Helmut Eller  <heller at common-lisp.net>
+
+	Speed up symbol completion.
+
+	* swank.lisp (all-completions): Don't call unparse-symbol
+	while matching.  That gets very slow in CCL's CCL package.
+	Just use symbol-name and compare with char-equal.
+	(prefix-match-p): Use char-equal.
+
 2009-08-21  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-transcript-start-hook)
--- /project/slime/cvsroot/slime/swank.lisp	2009/08/16 20:00:09	1.658
+++ /project/slime/cvsroot/slime/swank.lisp	2009/08/27 20:19:26	1.659
@@ -2947,19 +2947,19 @@
 
 ;;;; Simple completion
 
-(defslimefun simple-completions (string package)
-  "Return a list of completions for the string STRING."
-  (let ((strings (all-completions string package #'prefix-match-p)))
+(defslimefun simple-completions (prefix package)
+  "Return a list of completions for the string PREFIX."
+  (let ((strings (all-completions prefix package)))
     (list strings (longest-common-prefix strings))))
 
-(defun all-completions (string package test)
-  (multiple-value-bind (name pname intern) (tokenize-symbol string)
+(defun all-completions (prefix package)
+  (multiple-value-bind (name pname intern) (tokenize-symbol prefix)
     (let* ((extern (and pname (not intern)))
-	   (pack (cond ((equal pname "") keyword-package)
-		       ((not pname) (guess-buffer-package package))
-		       (t (guess-package pname))))
-	   (test (lambda (sym) (funcall test name (unparse-symbol sym))))
-	   (syms (and pack (matching-symbols pack extern test))))
+	   (pkg (cond ((equal pname "") keyword-package)
+                      ((not pname) (guess-buffer-package package))
+                      (t (guess-package pname))))
+	   (test (lambda (sym) (prefix-match-p name (symbol-name sym))))
+	   (syms (and pkg (matching-symbols pkg extern test))))
       (format-completion-set (mapcar #'unparse-symbol syms) intern pname))))
 
 (defun matching-symbols (package external test)
@@ -2982,7 +2982,8 @@
 
 (defun prefix-match-p (prefix string)
   "Return true if PREFIX is a prefix of STRING."
-  (not (mismatch prefix string :end2 (min (length string) (length prefix)))))
+  (not (mismatch prefix string :end2 (min (length string) (length prefix))
+                 :test #'char-equal)))
 
 (defun longest-common-prefix (strings)
   "Return the longest string that is a common prefix of STRINGS."




From sboukarev at common-lisp.net  Thu Aug 27 21:57:48 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Thu, 27 Aug 2009 17:57:48 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1Mgmya-0003MJ-Gv@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
slime.el(slime-remove-old-overlays): Fix stupid bug introduce by me the previous commit.


--- /project/slime/cvsroot/slime/slime.el	2009/08/27 15:24:31	1.1216
+++ /project/slime/cvsroot/slime/slime.el	2009/08/27 21:57:48	1.1217
@@ -2811,7 +2811,7 @@
 
 (defun slime-remove-old-overlays ()
   "Delete the existing Slime overlays in the current buffer."
-  (dolist (buffer (slime-filter-buffers 'slime-mode))
+  (dolist (buffer (slime-filter-buffers (lambda () slime-mode)))
     (with-current-buffer buffer
       (save-excursion
         (save-restriction




From sboukarev at common-lisp.net  Fri Aug 28 23:50:49 2009
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 28 Aug 2009 19:50:49 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1MhBDV-0001US-0L@common-lisp.net>

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

Modified Files:
	ChangeLog slime-c-p-c.el 
Log Message:
* slime-c-p-c.el (slime-contextual-completions): Remove debugging code.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/27 20:15:43	1.238
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/08/28 23:50:48	1.239
@@ -1,3 +1,7 @@
+2009-08-28  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-c-p-c.el (slime-contextual-completions): Remove debugging code.
+
 2009-08-27  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-c-p-c.el (slime-contextual-completions): Detect characters properly.
--- /project/slime/cvsroot/slime/contrib/slime-c-p-c.el	2009/08/27 15:46:01	1.11
+++ /project/slime/cvsroot/slime/contrib/slime-c-p-c.el	2009/08/28 23:50:48	1.12
@@ -128,7 +128,7 @@
             ;; completion.
             ))))
      ((and (>= (length token) 2)
-           (string= (dbgmsg (subseq token 0 2)) "#\\"))
+           (string= (subseq token 0 2) "#\\"))
       ;; Character name completion
       (return-from slime-contextual-completions
         (slime-completions-for-character token))))




From heller at common-lisp.net  Mon Aug 31 17:08:09 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 31 Aug 2009 13:08:09 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MiAMT-0006u5-VS@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Keep note overlays in a global variable.
That's simpler and cheaper than scanning all buffers.

* slime.el (slime-note-overlays): New variable.
(slime-make-note-overlay, slime-remove-old-overlays): Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/27 20:19:26	1.1845
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/31 17:08:09	1.1846
@@ -1,3 +1,11 @@
+2009-08-31  Helmut Eller  <heller at common-lisp.net>
+
+	Keep note overlays in a global variable.
+	That's simpler and cheaper than scanning all buffers.
+
+	* slime.el (slime-note-overlays): New variable.
+	(slime-make-note-overlay, slime-remove-old-overlays): Use it.
+
 2009-08-27  Stas Boukarev  <stassats at gmail.com>
 
 	* slime.el (slime-remove-old-overlays): delete notes at the very beginning
--- /project/slime/cvsroot/slime/slime.el	2009/08/27 21:57:48	1.1217
+++ /project/slime/cvsroot/slime/slime.el	2009/08/31 17:08:09	1.1218
@@ -2809,19 +2809,13 @@
         (slime-remove-old-overlays)
         (mapc #'slime-overlay-note (slime-merge-notes-for-display notes))))))
 
+(defvar slime-note-overlays '()
+  "List of overlays created by `slime-make-note-overlay'")
+
 (defun slime-remove-old-overlays ()
-  "Delete the existing Slime overlays in the current buffer."
-  (dolist (buffer (slime-filter-buffers (lambda () slime-mode)))
-    (with-current-buffer buffer
-      (save-excursion
-        (save-restriction
-          (widen)                ; remove overlays within the whole buffer.
-          (goto-char (point-min))
-          (let ((o (slime-note-at-point)))
-            (when o
-              (delete-overlay o))
-            (while (setq o (slime-find-next-note))
-              (delete-overlay o))))))))
+  "Delete the existing note overlays."
+  (mapc #'delete-overlay slime-note-overlays)
+  (setq slime-note-overlays '()))
 
 (defun slime-filter-buffers (predicate)
   "Return a list of where PREDICATE returns true.
@@ -3124,6 +3118,7 @@
 (defun slime-make-note-overlay (note start end)
   (let ((overlay (make-overlay start end)))
     (overlay-put overlay 'slime-note note)
+    (push overlay slime-note-overlays)
     overlay))
 
 (defun slime-create-note-overlay (note start end severity message)




From heller at common-lisp.net  Mon Aug 31 17:08:17 2009
From: heller at common-lisp.net (CVS User heller)
Date: Mon, 31 Aug 2009 13:08:17 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1MiAMb-0006uj-AD@common-lisp.net>

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

Modified Files:
	ChangeLog swank-ccl.lisp 
Log Message:
Don't advice ccl::break-loop.
Should not be necessary as we can now use ccl:*break-hook*.

* swank-ccl.lisp ([advice] ccl::break-loop): Deleted.

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/31 17:08:09	1.1846
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/31 17:08:17	1.1847
@@ -1,5 +1,12 @@
 2009-08-31  Helmut Eller  <heller at common-lisp.net>
 
+	Don't advice ccl::break-loop.
+	Should not be necessary as we can now use ccl:*break-hook*.
+
+	* swank-ccl.lisp ([advice] ccl::break-loop): Deleted.
+
+2009-08-31  Helmut Eller  <heller at common-lisp.net>
+
 	Keep note overlays in a global variable.
 	That's simpler and cheaper than scanning all buffers.
 
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2009/08/15 08:34:56	1.4
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2009/08/31 17:08:17	1.5
@@ -384,23 +384,6 @@
   (setq ccl:*select-interactive-process-hook* 'find-repl-thread)
   )
 
-(let ((ccl::*warn-if-redefine-kernel* nil))
-  ;; Everybody (error, cerror, break, invoke-debugger, and async interrupts) ends up
-  ;; in CCL::BREAK-LOOP, which implements the default debugger. Regardless of how it
-  ;; was entered, make sure it runs with the swank connection state established so
-  ;; that i/o happens via emacs and there is no contention for the terminal (stdin).
-  (ccl:advise
-   ccl::break-loop
-   (if (symbol-value (swank-sym *emacs-connection*))
-     (:do-it)
-     (let ((conn (funcall (swank-sym default-connection))))
-       (if conn
-         (funcall (swank-sym call-with-connection) conn
-                  (lambda () (:do-it)))
-         (:do-it))))
-   :when :around
-   :name swank-default-debugger-context))
-
 (defun map-backtrace (function &optional
                                (start-frame-number 0)
                                (end-frame-number most-positive-fixnum))