From sboukarev at common-lisp.net  Fri Feb  1 10:03:42 2013
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 01 Feb 2013 02:03:42 -0800
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1U1DTC-0003rX-AU@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory tiger.common-lisp.net:/tmp/cvs-serv14838

Modified Files:
	ChangeLog swank-asdf.lisp 
Log Message:
* swank-asdf.lisp (asdf-determine-system): Return the name of a
system.
Reported by Tamas Papp.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2013/01/29 16:17:24	1.565
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2013/02/01 10:03:41	1.566
@@ -1,3 +1,9 @@
+2013-02-01  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-asdf.lisp (asdf-determine-system): Return the name of a
+	system.
+	Reported by Tamas Papp.
+
 2013-01-29  Francois-Rene Rideau <tunes at google.com>
 
 	* swank-asdf.lisp: Better upcoming ASDF3 support.
--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2013/01/29 16:17:24	1.37
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2013/02/01 10:03:42	1.38
@@ -448,21 +448,26 @@
 (defun pathname-system (pathname)
   (let ((component (pathname-component pathname)))
     (when component
-      (asdf:component-system component))))
+      (asdf:component-name (asdf:component-system component)))))
 
 (defslimefun asdf-determine-system (file buffer-package-name)
   (or
-   (pathname-system file)
-   (progn ; If not found, let's rebuild the table first
-     (recompute-pathname-component-table)
-     (pathname-system file))
+   (and file
+        (pathname-system file))
+   (and file
+        (progn
+          ;; If not found, let's rebuild the table first
+          (recompute-pathname-component-table)
+          (pathname-system file)))
    ;; If we couldn't find an already defined system,
    ;; try finding a system that's named like BUFFER-PACKAGE-NAME.
-   (loop :with package = (guess-buffer-package buffer-package-name)
-         :for name :in (package-names package)
-         :for system = (asdf:find-system (asdf::coerce-name name) nil)
-         :when system :do (register-system-pathnames system)
-         :thereis (pathname-system file))))
+   (loop with package = (guess-buffer-package buffer-package-name)
+         for name in (package-names package)
+         for system = (asdf:find-system (asdf::coerce-name name) nil)
+         when (and system
+                   (or (not file)
+                       (pathname-system file)))
+         return (asdf:component-name system))))
 
 (defslimefun delete-system-fasls (name)
   (let ((removed-count




From sboukarev at common-lisp.net  Fri Feb  1 20:43:13 2013
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 01 Feb 2013 12:43:13 -0800
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1U1NS5-00059i-Ti@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory tiger.common-lisp.net:/tmp/cvs-serv19807

Modified Files:
	ChangeLog slime-asdf.el 
Log Message:
* slime-asdf.el (slime-determine-asdf-system): Don't call
slime-to-lisp-filename on NIL.
Reported by Tamas Papp.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2013/02/01 10:03:41	1.566
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2013/02/01 20:43:13	1.567
@@ -1,5 +1,9 @@
 2013-02-01  Stas Boukarev  <stassats at gmail.com>
 
+	* slime-asdf.el (slime-determine-asdf-system): Don't call
+	slime-to-lisp-filename on NIL.
+	Reported by Tamas Papp.
+
 	* swank-asdf.lisp (asdf-determine-system): Return the name of a
 	system.
 	Reported by Tamas Papp.
--- /project/slime/cvsroot/slime/contrib/slime-asdf.el	2011/12/06 18:57:18	1.33
+++ /project/slime/cvsroot/slime/contrib/slime-asdf.el	2013/02/01 20:43:13	1.34
@@ -36,13 +36,14 @@
   (let* ((completion-ignore-case nil)
          (prompt (or prompt "System"))
          (system-names (slime-eval `(swank:list-asdf-systems)))
-         (default-value (or default-value 
-                            (if determine-default-accurately
-                                (slime-determine-asdf-system (buffer-file-name)
-                                                             (slime-current-package))
-                                (slime-find-asd-file (or default-directory
-                                                         (buffer-file-name))
-                                                     system-names))))
+         (default-value
+           (or default-value 
+               (if determine-default-accurately
+                   (slime-determine-asdf-system (buffer-file-name)
+                                                (slime-current-package))
+                   (slime-find-asd-file (or default-directory
+                                            (buffer-file-name))
+                                        system-names))))
          (prompt (concat prompt (if default-value
                                     (format " (default `%s'): " default-value)
                                     ": "))))
@@ -64,8 +65,10 @@
 
 (defun slime-determine-asdf-system (filename buffer-package)
   "Try to determine the asdf system that `filename' belongs to."
-  (slime-eval `(swank:asdf-determine-system ,(slime-to-lisp-filename filename)
-                                            ,buffer-package)))
+  (slime-eval
+   `(swank:asdf-determine-system ,(and filename
+                                       (slime-to-lisp-filename filename))
+                                 ,buffer-package)))
 
 (defun slime-who-depends-on-rpc (system)
   (slime-eval `(swank:who-depends-on ,system)))




From sboukarev at common-lisp.net  Sat Feb  2 09:48:51 2013
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sat, 02 Feb 2013 01:48:51 -0800
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1U1ZiN-00032B-Oc@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory tiger.common-lisp.net:/tmp/cvs-serv11653

Modified Files:
	ChangeLog swank-fuzzy.lisp 
Log Message:
* swank-fuzzy.lisp: Allow NIL to be completed, don't confuse with
it package:


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2013/02/01 20:43:13	1.567
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2013/02/02 09:48:51	1.568
@@ -1,3 +1,8 @@
+2013-02-02  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-fuzzy.lisp: Allow NIL to be completed, don't confuse with
+	it package:
+
 2013-02-01  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-asdf.el (slime-determine-asdf-system): Don't call
--- /project/slime/cvsroot/slime/contrib/swank-fuzzy.lisp	2011/12/01 16:48:22	1.13
+++ /project/slime/cvsroot/slime/contrib/swank-fuzzy.lisp	2013/02/02 09:48:51	1.14
@@ -17,7 +17,8 @@
 ;;; For nomenclature of the fuzzy completion section, please read
 ;;; through the following docstring.
 
-(defslimefun fuzzy-completions (string default-package-name &key limit time-limit-in-msec)
+(defslimefun fuzzy-completions (string default-package-name
+                                &key limit time-limit-in-msec)
 "Returns a list of two values:
 
   An (optionally limited to LIMIT best results) list of fuzzy
@@ -62,7 +63,8 @@
   ;; that purpose, to be able to distinguish between "no time limit
   ;; alltogether" and "current time limit already exhausted." So we've
   ;; got to canonicalize its value at first:
-  (let* ((no-time-limit-p (or (not time-limit-in-msec) (zerop time-limit-in-msec)))
+  (let* ((no-time-limit-p (or (not time-limit-in-msec)
+                              (zerop time-limit-in-msec)))
          (time-limit (if no-time-limit-p nil time-limit-in-msec)))
     (multiple-value-bind (completion-set interrupted-p)
         (fuzzy-completion-set string default-package-name :limit limit
@@ -78,55 +80,63 @@
 ;;; object that will be sent back to Emacs, as described above.
 
 (defstruct (fuzzy-matching (:conc-name   fuzzy-matching.)
-			   (:predicate   fuzzy-matching-p)
-			   (:constructor %make-fuzzy-matching))
-  symbol	    ; The symbol that has been found to match.
-  package-name	    ; The name of the package where SYMBOL was found in.
+                           (:predicate   fuzzy-matching-p)
+                           (:constructor %make-fuzzy-matching))
+  symbol            ; The symbol that has been found to match.
+  symbol-p          ; To deffirentiate between completeing
+                    ; package: and package:nil
+  package-name      ; The name of the package where SYMBOL was found in.
                     ;  (This is not necessarily the same as the home-package
                     ;   of SYMBOL, because the SYMBOL can be internal to
                     ;   lots of packages; also think of package nicknames.)
-  score	            ; The higher the better SYMBOL is a match.
+  score             ; The higher the better SYMBOL is a match.
   package-chunks    ; Chunks pertaining to the package identifier of SYMBOL.
   symbol-chunks)    ; Chunks pertaining to SYMBOL's name.
 
-(defun make-fuzzy-matching (symbol package-name score package-chunks symbol-chunks)
+(defun make-fuzzy-matching (symbol package-name score package-chunks
+                            symbol-chunks &key (symbol-p t))
   (declare (inline %make-fuzzy-matching))
   (%make-fuzzy-matching :symbol symbol :package-name package-name :score score
-			:package-chunks package-chunks
-			:symbol-chunks symbol-chunks))
+                        :package-chunks package-chunks
+                        :symbol-chunks symbol-chunks
+                        :symbol-p symbol-p))
 
 (defun %fuzzy-extract-matching-info (fuzzy-matching user-input-string)
   (multiple-value-bind (_ user-package-name __ input-internal-p)
       (parse-completion-arguments user-input-string nil)
     (declare (ignore _ __))
-    (with-struct (fuzzy-matching. score symbol package-name package-chunks symbol-chunks)
-	fuzzy-matching
+    (with-struct (fuzzy-matching. score symbol package-name package-chunks
+                                  symbol-chunks symbol-p)
+        fuzzy-matching
       (let (symbol-name real-package-name internal-p)
-	(cond (symbol ; symbol fuzzy matching?
-	       (setf symbol-name (symbol-name symbol))
-	       (setf internal-p input-internal-p)
-	       (setf real-package-name (cond ((keywordp symbol)     "")
-					     ((not user-package-name) nil)
-					     (t package-name))))
-	      (t      ; package fuzzy matching?
-	       (setf symbol-name "")
-	       (setf real-package-name package-name)
-	       ;; If no explicit package name was given by the user
-	       ;; (e.g. input was "asdf"), we want to append only
-	       ;; one colon ":" to the package names.
-	       (setf internal-p (if user-package-name input-internal-p nil))))
-	(values symbol-name
-		real-package-name
-		(if user-package-name internal-p nil)
-		(completion-output-symbol-converter user-input-string)
-		(completion-output-package-converter user-input-string))))))
+        (cond (symbol-p ; symbol fuzzy matching?
+               (setf symbol-name (symbol-name symbol))
+               (setf internal-p input-internal-p)
+               (setf real-package-name (cond ((keywordp symbol)     "")
+                                             ((not user-package-name) nil)
+                                             (t package-name))))
+              (t      ; package fuzzy matching?
+               (setf symbol-name "")
+               (setf real-package-name package-name)
+               ;; If no explicit package name was given by the user
+               ;; (e.g. input was "asdf"), we want to append only
+               ;; one colon ":" to the package names.
+               (setf internal-p (if user-package-name input-internal-p nil))))
+        (values symbol-name
+                real-package-name
+                (if user-package-name internal-p nil)
+                (completion-output-symbol-converter user-input-string)
+                (completion-output-package-converter user-input-string))))))
 
 (defun fuzzy-format-matching (fuzzy-matching user-input-string)
   "Returns the completion (\"foo:bar\") that's represented by FUZZY-MATCHING."
-  (multiple-value-bind (symbol-name package-name internal-p symbol-converter package-converter)
+  (multiple-value-bind (symbol-name package-name internal-p
+                        symbol-converter package-converter)
       (%fuzzy-extract-matching-info fuzzy-matching user-input-string)
-    (setq symbol-name  (and symbol-name  (funcall symbol-converter symbol-name)))
-    (setq package-name (and package-name (funcall package-converter package-name)))
+    (setq symbol-name (and symbol-name
+                           (funcall symbol-converter symbol-name)))
+    (setq package-name (and package-name
+                            (funcall package-converter package-name)))
     (let ((result (untokenize-symbol package-name internal-p symbol-name)))
       ;; We return the length of the possibly added prefix as second value.
       (values result (search symbol-name result)))))
@@ -137,21 +147,27 @@
 issues, and adds information (as a string) describing if the symbol is
 bound, fbound, a class, a macro, a generic-function, a
 special-operator, or a package."
-  (with-struct (fuzzy-matching. symbol score package-chunks symbol-chunks) fuzzy-matching
+  (with-struct (fuzzy-matching. symbol score package-chunks symbol-chunks
+                                symbol-p)
+               fuzzy-matching
     (multiple-value-bind (name added-length)
-	(fuzzy-format-matching fuzzy-matching user-input-string)
+        (fuzzy-format-matching fuzzy-matching user-input-string)
       (list name
             (format nil "~,2f" score)
-	    (append package-chunks
-		    (mapcar #'(lambda (chunk)
-				;; Fix up chunk positions to account for possible
-				;; added package identifier.
-				(let ((offset (first chunk)) (string (second chunk)))
-				  (list (+ added-length offset) string))) 
-			    symbol-chunks))
-	    (symbol-classification-string symbol)))))
+            (append package-chunks
+                    (mapcar (lambda (chunk)
+                              ;; Fix up chunk positions to account for possible
+                              ;; added package identifier.
+                              (let ((offset (first chunk))
+                                    (string (second chunk)))
+                                (list (+ added-length offset) string)))
+                            symbol-chunks))
+            (if symbol-p
+                (symbol-classification-string symbol)
+                "-------p")))))
 
-(defun fuzzy-completion-set (string default-package-name &key limit time-limit-in-msec)
+(defun fuzzy-completion-set (string default-package-name
+                             &key limit time-limit-in-msec)
   "Returns two values: an array of completion objects, sorted by
 their score, that is how well they are a match for STRING
 according to the fuzzy completion algorithm.  If LIMIT is set,
@@ -159,7 +175,8 @@
 is returned that indicates whether or not TIME-LIMIT-IN-MSEC was
 exhausted."
   (check-type limit (or null (integer 0 #.(1- most-positive-fixnum))))
-  (check-type time-limit-in-msec (or null (integer 0 #.(1- most-positive-fixnum))))
+  (check-type time-limit-in-msec
+              (or null (integer 0 #.(1- most-positive-fixnum))))
   (multiple-value-bind (matchings interrupted-p)
       (fuzzy-generate-matchings string default-package-name time-limit-in-msec)
     (when (and limit
@@ -169,92 +186,106 @@
           (setf (fill-pointer matchings) limit)
           (setf matchings (make-array limit :displaced-to matchings))))
     (map-into matchings #'(lambda (m)
-			    (fuzzy-convert-matching-for-emacs m string))
-	      matchings)
+                            (fuzzy-convert-matching-for-emacs m string))
+              matchings)
     (values matchings interrupted-p)))
 
 
-(defun fuzzy-generate-matchings (string default-package-name time-limit-in-msec)
+(defun fuzzy-generate-matchings (string default-package-name
+                                 time-limit-in-msec)
   "Does all the hard work for FUZZY-COMPLETION-SET. If
 TIME-LIMIT-IN-MSEC is NIL, an infinite time limit is assumed."
-  (multiple-value-bind (parsed-symbol-name parsed-package-name package internal-p)
+  (multiple-value-bind (parsed-symbol-name parsed-package-name
+                        package internal-p)
       (parse-completion-arguments string default-package-name)
     (flet ((fix-up (matchings parent-package-matching)
-	     ;; The components of each matching in MATCHINGS have been computed
-	     ;; relatively to PARENT-PACKAGE-MATCHING. Make them absolute.
-	     (let* ((p parent-package-matching)
-		    (p.name   (fuzzy-matching.package-name p))
-		    (p.score  (fuzzy-matching.score p))
-		    (p.chunks (fuzzy-matching.package-chunks p)))
-	       (map-into matchings
-			 #'(lambda (m)
-			     (let ((m.score (fuzzy-matching.score m)))
-			       (setf (fuzzy-matching.package-name m) p.name)
-			       (setf (fuzzy-matching.package-chunks m) p.chunks)
-			       (setf (fuzzy-matching.score m)
-				     (if (equal parsed-symbol-name "")
-					 ;; (Make package matchings be sorted before all the
-					 ;; relative symbol matchings while preserving over
-					 ;; all orderness.)
-					 (/ p.score 100)        
-					 (+ p.score m.score)))
-			       m))
-			 matchings)))
-	   (find-symbols (designator package time-limit &optional filter)
-	     (fuzzy-find-matching-symbols designator package
-					  :time-limit-in-msec time-limit
-					  :external-only (not internal-p)
-					  :filter (or filter #'identity)))
-	   (find-packages (designator time-limit)
-	     (fuzzy-find-matching-packages designator :time-limit-in-msec time-limit)))
+             ;; The components of each matching in MATCHINGS have been computed
+             ;; relatively to PARENT-PACKAGE-MATCHING. Make them absolute.
+             (let* ((p parent-package-matching)
+                    (p.name   (fuzzy-matching.package-name p))
+                    (p.score  (fuzzy-matching.score p))
+                    (p.chunks (fuzzy-matching.package-chunks p)))
+               (map-into
+                matchings
+                (lambda (m)
+                  (let ((m.score (fuzzy-matching.score m)))
+                    (setf (fuzzy-matching.package-name m) p.name)
+                    (setf (fuzzy-matching.package-chunks m) p.chunks)
+                    (setf (fuzzy-matching.score m)
+                          (if (equal parsed-symbol-name "")
+                              ;; Make package matchings be sorted before all
+                              ;; the relative symbol matchings while preserving
+                              ;; over all orderness.
+                              (/ p.score 100)
+                              (+ p.score m.score)))
+                    m))
+                matchings)))
+           (find-symbols (designator package time-limit &optional filter)
+             (fuzzy-find-matching-symbols designator package
+                                          :time-limit-in-msec time-limit
+                                          :external-only (not internal-p)
+                                          :filter (or filter #'identity)))
+           (find-packages (designator time-limit)
+             (fuzzy-find-matching-packages designator
+                                           :time-limit-in-msec time-limit)))
       (let ((time-limit time-limit-in-msec) (symbols) (packages) (results))
-	(cond ((not parsed-package-name) ; E.g. STRING = "asd"
-	       ;; We don't know if user is searching for a package or a symbol
-	       ;; within his current package. So we try to find either.
-	       (setf (values packages time-limit) (find-packages parsed-symbol-name time-limit))
-	       (setf (values symbols  time-limit) (find-symbols parsed-symbol-name package time-limit)))
-	      ((string= parsed-package-name "") ; E.g. STRING = ":" or ":foo"
-	       (setf (values symbols time-limit) (find-symbols parsed-symbol-name package time-limit)))
-	      (t		   ; E.g. STRING = "asd:" or "asd:foo"
-	       ;; Find fuzzy matchings of the denoted package identifier part.
-	       ;; After that, find matchings for the denoted symbol identifier
-	       ;; relative to all the packages found.
-	       (multiple-value-bind (found-packages rest-time-limit)
-		   (find-packages parsed-package-name time-limit-in-msec)
-		 ;; We want to traverse the found packages in the order of their score,
-		 ;; since those with higher score presumably represent better choices.
-		 ;; (This is important because some packages may never be looked at if
-		 ;;  time limit exhausts during traversal.)
-		 (setf found-packages (sort found-packages #'fuzzy-matching-greaterp))
-		 (loop
-		       for package-matching across found-packages
-		       for package = (find-package (fuzzy-matching.package-name package-matching))
-		       while (or (not time-limit) (> rest-time-limit 0)) do
-		         (multiple-value-bind (matchings remaining-time)
-			     ;; The duplication filter removes all those symbols which are
-			     ;; present in more than one package match. Specifically if such a
-			     ;; package match represents the home package of the symbol, it's
-			     ;; the one kept because this one is deemed to be the best match.
-			     (find-symbols parsed-symbol-name package rest-time-limit
-					   (%make-duplicate-symbols-filter
-					    (remove package-matching found-packages)))
-			   (setf matchings (fix-up matchings package-matching))
-			   (setf symbols   (concatenate 'vector symbols matchings))
-			   (setf rest-time-limit remaining-time)
-			   (let ((guessed-sort-duration (%guess-sort-duration (length symbols))))
-			     (when (<= rest-time-limit guessed-sort-duration)
-			       (decf rest-time-limit guessed-sort-duration)
-			       (loop-finish))))
-		       finally
-		         (setf time-limit rest-time-limit)
-		         (when (equal parsed-symbol-name "") ; E.g. STRING = "asd:"
-			   (setf packages found-packages))))))
-	;; Sort by score; thing with equal score, sort alphabetically.
-	;; (Especially useful when PARSED-SYMBOL-NAME is empty, and all possible
-	;; completions are to be returned.)
-	(setf results (concatenate 'vector symbols packages))
-	(setf results (sort results #'fuzzy-matching-greaterp))
-	(values results (and time-limit (<= time-limit 0)))))))
+        (cond ((not parsed-package-name) ; E.g. STRING = "asd"
+               ;; We don't know if user is searching for a package or a symbol
+               ;; within his current package. So we try to find either.
+               (setf (values packages time-limit)
+                     (find-packages parsed-symbol-name time-limit))
+               (setf (values symbols  time-limit)
+                     (find-symbols parsed-symbol-name package time-limit)))
+              ((string= parsed-package-name "") ; E.g. STRING = ":" or ":foo"
+               (setf (values symbols time-limit)
+                     (find-symbols parsed-symbol-name package time-limit)))
+              (t                   ; E.g. STRING = "asd:" or "asd:foo"
+               ;; Find fuzzy matchings of the denoted package identifier part.
+               ;; After that, find matchings for the denoted symbol identifier
+               ;; relative to all the packages found.
+               (multiple-value-bind (symbol-packages rest-time-limit)
+                   (find-packages parsed-package-name time-limit-in-msec)
+                 ;; We want to traverse the found packages in the order of
+                 ;; their score, since those with higher score presumably
+                 ;; represent better choices.  (This is important because some
+                 ;; packages may never be looked at if time limit exhausts
+                 ;; during traversal.)
+                 (setf symbol-packages
+                       (sort symbol-packages #'fuzzy-matching-greaterp))
+                 (loop
+                   for package-matching across symbol-packages
+                   for package = (find-package (fuzzy-matching.package-name
+                                                package-matching))
+                   while (or (not time-limit) (> rest-time-limit 0)) do
+                   (multiple-value-bind (matchings remaining-time)
+                       ;; The duplication filter removes all those symbols
+                       ;; which are present in more than one package
+                       ;; match. Specifically if such a package match
+                       ;; represents the home package of the symbol, it's the
+                       ;; one kept because this one is deemed to be the best
+                       ;; match.
+                       (find-symbols parsed-symbol-name package rest-time-limit
+                                     (%make-duplicate-symbols-filter
+                                      (remove package-matching
+                                              symbol-packages)))
+                     (setf matchings (fix-up matchings package-matching))
+                     (setf symbols   (concatenate 'vector symbols matchings))
+                     (setf rest-time-limit remaining-time)
+                     (let ((guessed-sort-duration
+                             (%guess-sort-duration (length symbols))))
+                       (when (<= rest-time-limit guessed-sort-duration)
+                         (decf rest-time-limit guessed-sort-duration)
+                         (loop-finish))))
+                   finally
+                   (setf time-limit rest-time-limit)
+                   (when (equal parsed-symbol-name "") ; E.g. STRING = "asd:"
+                     (setf packages symbol-packages))))))
+        ;; Sort by score; thing with equal score, sort alphabetically.
+        ;; (Especially useful when PARSED-SYMBOL-NAME is empty, and all
+        ;; possible completions are to be returned.)
+        (setf results (concatenate 'vector symbols packages))
+        (setf results (sort results #'fuzzy-matching-greaterp))
+        (values results (and time-limit (<= time-limit 0)))))))
 
 (defun %guess-sort-duration (length)
   ;; These numbers are pretty much arbitrary, except that they're
@@ -264,17 +295,17 @@
   (if (zerop length)
       0
       (let ((comparasions (* 3.8 (* length (log length 2)))))
-	(* 1000 (* comparasions (expt 10 -7)))))) ; msecs
+        (* 1000 (* comparasions (expt 10 -7)))))) ; msecs
 
 (defun %make-duplicate-symbols-filter (fuzzy-package-matchings)
   ;; Returns a filter function that takes a symbol, and which returns T
   ;; if and only if /no/ matching in FUZZY-PACKAGE-MATCHINGS represents
   ;; the home-package of the symbol passed.
   (let ((packages (mapcar #'(lambda (m)
-			      (find-package (fuzzy-matching.package-name m)))
-			  (coerce fuzzy-package-matchings 'list))))
+                              (find-package (fuzzy-matching.package-name m)))
+                          (coerce fuzzy-package-matchings 'list))))
     #'(lambda (symbol)
-	(not (member (symbol-package symbol) packages)))))
+        (not (member (symbol-package symbol) packages)))))
 
 (defun fuzzy-matching-greaterp (m1 m2)
   "Returns T if fuzzy-matching M1 should be sorted before M2.
@@ -283,18 +314,18 @@
 equal, the one which comes alphabetically first wins."
   (declare (type fuzzy-matching m1 m2))
   (let ((score1 (fuzzy-matching.score m1))
-	(score2 (fuzzy-matching.score m2)))
+        (score2 (fuzzy-matching.score m2)))
     (cond ((> score1 score2) t)
-	  ((< score1 score2) nil)	; total order
-	  (t
-	   (let ((name1 (symbol-name (fuzzy-matching.symbol m1)))
-		 (name2 (symbol-name (fuzzy-matching.symbol m2))))
-	     (string< name1 name2))))))
+          ((< score1 score2) nil)       ; total order
+          (t
+           (let ((name1 (symbol-name (fuzzy-matching.symbol m1)))
+                 (name2 (symbol-name (fuzzy-matching.symbol m2))))
+             (string< name1 name2))))))
 
 (declaim (ftype (function () (integer 0)) get-real-time-msecs))
 (defun get-real-time-in-msecs ()
   (let ((units-per-msec (max 1 (floor internal-time-units-per-second 1000))))
-    (values (floor (get-internal-real-time) units-per-msec)))) ; return just one value!
+    (values (floor (get-internal-real-time) units-per-msec))))
 
 (defun fuzzy-find-matching-symbols
     (string package &key (filter #'identity) external-only time-limit-in-msec)
@@ -310,7 +341,7 @@

[261 lines skipped]




From sboukarev at common-lisp.net  Sat Feb  2 10:11:16 2013
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sat, 02 Feb 2013 02:11:16 -0800
Subject: [slime-cvs] CVS slime
Message-ID: <E1U1a44-0006mf-V4@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv25982

Modified Files:
	ChangeLog swank-allegro.lisp swank-backend.lisp swank-ccl.lisp 
	swank-clisp.lisp swank-ecl.lisp swank-lispworks.lisp 
	swank-sbcl.lisp 
Log Message:
* swank-backend.lisp (type-specifier-p): New.
Implement it for ACL, ECL, CCL, Clisp, SBCL, LW.

* contrib/swank-util.lisp (symbol-classification-string): Use
type-specifier-p.


--- /project/slime/cvsroot/slime/ChangeLog	2013/01/12 12:32:20	1.2389
+++ /project/slime/cvsroot/slime/ChangeLog	2013/02/02 10:11:16	1.2390
@@ -1,3 +1,8 @@
+2013-02-02  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-backend.lisp (type-specifier-p): New.
+	Implement it for ACL, ECL, CCL, Clisp, SBCL, LW.
+
 2013-01-12  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-backend.lisp: Add a couple of ignore declarations.
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2012/12/03 03:35:09	1.157
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2013/02/02 10:11:16	1.158
@@ -140,6 +140,11 @@
     (:class
      (describe (find-class symbol)))))
 
+(defimplementation type-specifier-p (symbol)
+  (or (ignore-errors
+       (subtypep nil symbol))
+      (not (eq (type-specifier-arglist symbol) :not-available))))
+
 ;;;; Debugger
 
 (defvar *sldb-topframe*)
--- /project/slime/cvsroot/slime/swank-backend.lisp	2013/01/12 12:32:21	1.223
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2013/02/02 10:11:16	1.224
@@ -781,6 +781,11 @@
                   :not-available))
       (t :not-available))))
 
+(definterface type-specifier-p (symbol)
+  "Determine if SYMBOL is a type-specifier."
+  (or (documentation symbol 'type)
+      (not (eq (type-specifier-arglist symbol) :not-available))))
+
 (definterface function-name (function)
   "Return the name of the function object FUNCTION.
 
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2013/01/07 13:01:28	1.31
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2013/02/02 10:11:16	1.32
@@ -694,6 +694,10 @@
     (loop for i below (ccl:uvsize object) append 
           (label-value-line (princ-to-string i) (ccl:uvref object i)))))
 
+(defimplementation type-specifier-p (symbol)
+  (or (ccl:type-specifier-p symbol)
+      (not (eq (type-specifier-arglist symbol) :not-available))))
+
 ;;; Multiprocessing
 
 (defvar *known-processes* 
--- /project/slime/cvsroot/slime/swank-clisp.lisp	2012/08/04 23:48:19	1.102
+++ /project/slime/cvsroot/slime/swank-clisp.lisp	2013/02/02 10:11:16	1.103
@@ -308,6 +308,11 @@
     (:function (describe (symbol-function symbol)))
     (:class (describe (find-class symbol)))))
 
+(defimplementation type-specifier-p (symbol)
+  (or (ignore-errors
+       (subtypep nil symbol))
+      (not (eq (type-specifier-arglist symbol) :not-available))))
+
 (defun fspec-pathname (spec)
   (let ((path spec)
 	type
--- /project/slime/cvsroot/slime/swank-ecl.lisp	2013/01/11 23:36:35	1.82
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2013/02/02 10:11:16	1.83
@@ -345,6 +345,10 @@
     (:class (documentation name 'class))
     (t nil)))
 
+(defimplementation type-specifier-p (symbol)
+  (or (subtypep nil symbol)
+      (not (eq (type-specifier-arglist symbol) :not-available))))
+
 
 ;;; Debugging
 
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2012/04/07 09:35:42	1.151
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2013/02/02 10:11:16	1.152
@@ -297,6 +297,11 @@
   (when (fboundp sym)
     (describe-function sym)))
 
+(defimplementation type-specifier-p (symbol)
+  (or (ignore-errors
+       (subtypep nil symbol))
+      (not (eq (type-specifier-arglist symbol) :not-available))))
+
 ;;; Debugging
 
 (defclass slime-env (env:environment) 
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2013/01/09 14:29:28	1.327
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2013/02/02 10:11:16	1.328
@@ -438,6 +438,9 @@
       (sb-introspect:deftype-lambda-list typespec-operator)
     (if foundp arglist (call-next-method))))
 
+(defimplementation type-specifier-p (symbol)
+  (or (sb-ext:valid-type-specifier-p symbol)
+      (not (eq (type-specifier-arglist symbol) :not-available))))
 
 (defvar *buffer-name* nil)
 (defvar *buffer-tmpfile* nil)




From sboukarev at common-lisp.net  Sat Feb  2 10:11:17 2013
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sat, 02 Feb 2013 02:11:17 -0800
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1U1a45-0006nQ-EI@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory tiger.common-lisp.net:/tmp/cvs-serv25982/contrib

Modified Files:
	ChangeLog swank-util.lisp 
Log Message:
* swank-backend.lisp (type-specifier-p): New.
Implement it for ACL, ECL, CCL, Clisp, SBCL, LW.

* contrib/swank-util.lisp (symbol-classification-string): Use
type-specifier-p.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2013/02/02 09:48:51	1.568
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2013/02/02 10:11:17	1.569
@@ -1,5 +1,8 @@
 2013-02-02  Stas Boukarev  <stassats at gmail.com>
 
+	* swank-util.lisp (symbol-classification-string): Use
+	type-specifier-p.
+
 	* swank-fuzzy.lisp: Allow NIL to be completed, don't confuse with
 	it package:
 
--- /project/slime/cvsroot/slime/contrib/swank-util.lisp	2012/03/06 20:55:13	1.2
+++ /project/slime/cvsroot/slime/contrib/swank-util.lisp	2013/02/02 10:11:17	1.3
@@ -44,10 +44,7 @@
 boundp fboundp generic-function class macro special-operator package"
   (let ((letters "bfgctmsp")
         (result (copy-seq "--------")))
-    (flet ((type-specifier-p (s)
-             (or (documentation s 'type)
-                 (not (eq (type-specifier-arglist s) :not-available))))
-           (flip (letter)
+    (flet ((flip (letter)
              (setf (char result (position letter letters))
                    letter)))
       (when (boundp symbol) (flip #\b))




From sboukarev at common-lisp.net  Sun Feb  3 12:13:43 2013
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sun, 03 Feb 2013 04:13:43 -0800
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1U1yS7-0001o9-0G@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory tiger.common-lisp.net:/tmp/cvs-serv6940

Modified Files:
	ChangeLog swank-sprof.lisp 
Log Message:
* swank-sprof.lisp (pretty-name): Better frame names.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2013/02/02 10:11:17	1.569
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2013/02/03 12:13:42	1.570
@@ -1,3 +1,7 @@
+2013-02-03  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-sprof.lisp (pretty-name): Better frame names.
+
 2013-02-02  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-util.lisp (symbol-classification-string): Use
--- /project/slime/cvsroot/slime/contrib/swank-sprof.lisp	2011/03/14 07:18:35	1.6
+++ /project/slime/cvsroot/slime/contrib/swank-sprof.lisp	2013/02/03 12:13:42	1.7
@@ -17,18 +17,29 @@
 (defvar *node-numbers* nil)
 (defvar *number-nodes* nil)
 
+(defun frame-name (name)
+  (if (consp name)
+      (case (first name)
+        ((sb-c::xep sb-c::tl-xep
+                    sb-c::&more-processor
+                    sb-c::top-level-form
+                    sb-c::&optional-processor)
+         (second name))
+        (sb-pcl::fast-method
+         (cdr name))
+        ((flet labels lambda)
+         (let* ((in (member :in name)))
+           (if (stringp (cadr in))
+               (append (ldiff name in) (cddr in))
+               name)))
+        (t
+         name))
+      name))
+
 (defun pretty-name (name)
   (let ((*package* (find-package :common-lisp-user))
         (*print-right-margin* most-positive-fixnum))
-    (format nil "~S" (if (consp name)
-                         (let ((head (car name)))
-                           (if (or (eq head 'sb-c::tl-xep)
-                                   (eq head 'sb-c::hairy-arg-processor)
-                                   (eq head 'sb-c::top-level-form)
-                                   (eq head 'sb-c::xep))
-                               (cadr name)
-                               name))
-                         name))))
+    (format nil "~S" (frame-name name))))
 
 (defun samples-percent (count)
   (sb-sprof::samples-percent *call-graph* count))
@@ -95,12 +106,11 @@
                     (list (gethash node *node-numbers*)
                           name
                           (samples-percent count)))))))
-      (list :callers (let ((edges (sort (copy-list (sb-sprof::node-callers node))
-                                        #'>
-                                        :key #'caller-count)))
-                       (loop for node in edges
-                             collect (serialize-node node
-                                                     (caller-count node))))
+      (list :callers (loop for node in
+                           (sort (copy-list (sb-sprof::node-callers node)) #'>
+                                 :key #'caller-count)
+                           collect (serialize-node node
+                                                   (caller-count node)))
             :calls (let ((edges (sort (copy-list (sb-sprof::vertex-edges node))
                                       #'>
                                       :key #'sb-sprof::call-count)))




From heller at common-lisp.net  Fri Feb  8 14:11:23 2013
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 08 Feb 2013 06:11:23 -0800
Subject: [slime-cvs] CVS slime
Message-ID: <E1U3ofj-0006CZ-IX@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv23804

Modified Files:
	ChangeLog swank-allegro.lisp 
Log Message:
* swank-allegro.lisp (handle-compiler-warning): Ignore "Closure
will be stack allocated" notes.  Those are harmless and there are
too many of them.
(pc-source-location, ldb-code-to-src-loc): Handle case when
excl::ldb-code-pc returns nil.

--- /project/slime/cvsroot/slime/ChangeLog	2013/02/02 10:11:16	1.2390
+++ /project/slime/cvsroot/slime/ChangeLog	2013/02/08 14:11:23	1.2391
@@ -1,3 +1,11 @@
+2013-02-08  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-allegro.lisp (handle-compiler-warning): Ignore "Closure
+	will be stack allocated" notes.  Those are harmless and there are
+	too many of them.
+	(pc-source-location, ldb-code-to-src-loc): Handle case when
+	excl::ldb-code-pc returns nil.
+
 2013-02-02  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-backend.lisp (type-specifier-p): New.
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2013/02/02 10:11:16	1.158
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2013/02/08 14:11:23	1.159
@@ -237,7 +237,8 @@
           (t
            (let* ((code-loc (find-if (lambda (c)
                                        (<= (- pc (sys::natural-width))
-                                           (excl::ldb-code-pc c)
+                                           (let ((x (excl::ldb-code-pc c)))
+                                             (or x -1))
                                            pc))
                                      debug-info)))
              (cond ((not code-loc)
@@ -250,7 +251,7 @@
   (declare (optimize debug))
   (let* ((func (excl::ldb-code-func code))
          (debug-info (excl::function-source-debug-info func))
-         (start (loop for i downfrom (excl::ldb-code-index code) 
+         (start (loop for i from (excl::ldb-code-index code) downto 0
                       for bpt = (aref debug-info i)
                       for start = (excl::ldb-code-start-char bpt)
                       when start return start))
@@ -362,9 +363,16 @@
 
 (defun handle-compiler-warning (condition)
   (declare (optimize (debug 3) (speed 0) (space 0)))
-  (cond ((and (not *buffer-name*) 
+  (cond ((and (not *buffer-name*)
               (compiler-undefined-functions-called-warning-p condition))
          (handle-undefined-functions-warning condition))
+        ((and (typep condition 'excl::compiler-note)
+              (let ((format (slot-value condition 'excl::format-control)))
+                (and (search "Closure" format)
+                     (search "will be stack allocated" format))))
+         ;; Ignore "Closure <foo> will be stack allocated" notes.
+         ;; That occurs often but is usually uninteresting.
+         )
         (t
          (signal-compiler-condition
           :original-condition condition
@@ -376,7 +384,7 @@
                       (reader-error  :read-error)
                       (error         :error))
           :message (format nil "~A" condition)
-          :location (if (typep condition 'reader-error) 
+          :location (if (typep condition 'reader-error)
                         (location-for-reader-error condition)
                         (location-for-warning condition))))))
 




From heller at common-lisp.net  Fri Feb  8 14:11:34 2013
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 08 Feb 2013 06:11:34 -0800
Subject: [slime-cvs] CVS slime
Message-ID: <E1U3ofu-0006Dh-SM@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv23873

Modified Files:
	ChangeLog swank-lispworks.lisp 
Log Message:
* swank-lispworks.lisp (frame-package): Implemented.
(function-name-package): New.

--- /project/slime/cvsroot/slime/ChangeLog	2013/02/08 14:11:23	1.2391
+++ /project/slime/cvsroot/slime/ChangeLog	2013/02/08 14:11:34	1.2392
@@ -1,5 +1,10 @@
 2013-02-08  Helmut Eller  <heller at common-lisp.net>
 
+	* swank-lispworks.lisp (frame-package): Implemented.
+	(function-name-package): New.
+
+2013-02-08  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-allegro.lisp (handle-compiler-warning): Ignore "Closure
 	will be stack allocated" notes.  Those are harmless and there are
 	too many of them.
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2013/02/02 10:11:16	1.152
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2013/02/08 14:11:34	1.153
@@ -459,10 +459,26 @@
   (let ((frame (nth-frame frame-number)))
     (dbg::dbg-eval form frame)))
 
+(defun function-name-package (name)
+  (typecase name
+    (null nil)
+    (symbol (symbol-package name))
+    ((cons (eql hcl:subfunction))
+     (destructuring-bind (name parent) (cdr name)
+       (declare (ignore name))
+       (function-name-package parent)))
+    ((cons (eql lw:top-level-form)) nil)
+    (t nil)))
+
+(defimplementation frame-package (frame-number)
+  (let ((frame (nth-frame frame-number)))
+    (if (dbg::call-frame-p frame)
+        (function-name-package (dbg::call-frame-function-name frame)))))
+
 (defimplementation return-from-frame (frame-number form)
   (let* ((frame (nth-frame frame-number))
          (return-frame (dbg::find-frame-for-return frame)))
-    (dbg::dbg-return-from-call-frame frame form return-frame 
+    (dbg::dbg-return-from-call-frame frame form return-frame
                                      dbg::*debugger-stack*)))
 
 (defimplementation restart-frame (frame-number)




From sboukarev at common-lisp.net  Sun Feb 10 19:29:30 2013
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sun, 10 Feb 2013 11:29:30 -0800
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1U4cag-00018y-B8@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory tiger.common-lisp.net:/tmp/cvs-serv4376

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
* slime-repl.el (slime-open-stream-to-lisp): Use current
connection host instead of slime-lisp-host.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2013/02/03 12:13:42	1.570
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2013/02/10 19:29:30	1.571
@@ -1,3 +1,8 @@
+2013-02-10  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-repl.el (slime-open-stream-to-lisp): Use current
+	connection host instead of slime-lisp-host.
+
 2013-02-03  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-sprof.lisp (pretty-name): Better frame names.
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2012/11/23 11:37:53	1.65
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2013/02/10 19:29:30	1.66
@@ -190,7 +190,8 @@
   (let ((stream (open-network-stream "*lisp-output-stream*" 
                                      (slime-with-connection-buffer ()
                                        (current-buffer))
-				     slime-lisp-host port))
+				     (car (process-contact (slime-connection)))
+                                     port))
         (emacs-coding-system (car (find coding-system
                                         slime-net-valid-coding-systems
                                         :key #'third))))




From heller at common-lisp.net  Wed Feb 13 07:27:14 2013
From: heller at common-lisp.net (CVS User heller)
Date: Tue, 12 Feb 2013 23:27:14 -0800
Subject: [slime-cvs] CVS slime
Message-ID: <E1U5WkM-00024V-Ly@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv7930

Modified Files:
	ChangeLog slime.el swank-allegro.lisp 
Log Message:
* swank-allegro.lisp (eval-in-frame): debugger:frame-var-name can
return nil; ignore those vars.

* slime.el (sldb-setup): Allegro somehow managed to enter sldb at
the same level twice.  Add an assertion that checks that the
condition is the same if sldb-level is the same as last time.

--- /project/slime/cvsroot/slime/ChangeLog	2013/02/08 14:11:34	1.2392
+++ /project/slime/cvsroot/slime/ChangeLog	2013/02/13 07:27:14	1.2393
@@ -1,3 +1,12 @@
+2013-02-13  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-allegro.lisp (eval-in-frame): debugger:frame-var-name can
+	return nil; ignore those vars.
+
+	* slime.el (sldb-setup): Allegro somehow managed to enter sldb at
+	the same level twice.  Add an assertion that checks that the
+	condition is the same if sldb-level is the same as last time.
+
 2013-02-08  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-lispworks.lisp (frame-package): Implemented.
--- /project/slime/cvsroot/slime/slime.el	2013/01/07 10:12:08	1.1426
+++ /project/slime/cvsroot/slime/slime.el	2013/02/13 07:27:14	1.1427
@@ -5456,6 +5456,11 @@
 portion of the backtrace. Frames are numbered from 0.
 CONTS is a list of pending Emacs continuations."
   (with-current-buffer (sldb-get-buffer thread)
+    (assert (if (equal sldb-level level)
+                (equal sldb-condition condition)
+              t)
+            () "Bug: sldb-level is equal but condition differs\n%s\n%s"
+            sldb-condition condition)
     (unless (equal sldb-level level)
       (setq buffer-read-only nil)
       (slime-save-local-variables (slime-popup-restore-data)
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2013/02/08 14:11:23	1.159
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2013/02/13 07:27:14	1.160
@@ -300,9 +300,9 @@
     ;; let-bind lexical variables
     (let ((vars (loop for i below (debugger:frame-number-vars frame)
                       for name = (debugger:frame-var-name frame i)
-                      if (symbolp name)
+                      if (typep name '(and symbol (not null) (not keyword)))
                       collect `(,name ',(debugger:frame-var-value frame i)))))
-      (debugger:eval-form-in-context 
+      (debugger:eval-form-in-context
        `(let* ,vars ,form)
        (debugger:environment-of-frame frame)))))
 




From heller at common-lisp.net  Wed Feb 13 07:45:04 2013
From: heller at common-lisp.net (CVS User heller)
Date: Tue, 12 Feb 2013 23:45:04 -0800
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1U5X1c-00034l-BR@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory tiger.common-lisp.net:/tmp/cvs-serv11580/contrib

Modified Files:
	ChangeLog swank-kawa.scm 
Log Message:
* swank-kawa.scm (listener-loop): Use close-port instead of
close-output-port.  close-output-port startet to signal errors in
recent versions.
(listener): Stop taking stack-snapshots on caught exceptions as
it's too slow. It was always expensive and in Java7 it's
unbearably slow.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2013/02/10 19:29:30	1.571
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2013/02/13 07:45:03	1.572
@@ -1,3 +1,12 @@
+2013-02-13  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-kawa.scm (listener-loop): Use close-port instead of
+	close-output-port.  close-output-port startet to signal errors in
+	recent versions.
+	(listener): Stop taking stack-snapshots on caught exceptions as
+	it's too slow. It was always expensive and in Java7 it's
+	unbearably slow.
+
 2013-02-10  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-repl.el (slime-open-stream-to-lisp): Use current
--- /project/slime/cvsroot/slime/contrib/swank-kawa.scm	2012/10/14 12:57:56	1.29
+++ /project/slime/cvsroot/slime/contrib/swank-kawa.scm	2013/02/13 07:45:04	1.30
@@ -602,7 +602,8 @@
     (let ((vm (as <vm> (rpc c `(get-vm)))))
       (send c `(set-listener ,(vm-mirror vm (current-thread))))
       (request-uncaught-exception-events vm)
-      (request-caught-exception-events vm)
+      ;;stack snaphost are too expensive
+      ;;(request-caught-exception-events vm)
       )
     (rpc c `(get-vm))
     (listener-loop c env out)))
@@ -619,7 +620,7 @@
     ;;(log "listener-loop: ~s ~s\n" (current-thread) c)
     (mlet ((form id) (recv c))
       (let ((restart (fun ()
-                       (close-output-port port)
+                       (close-port port)
                        (reply-abort c id)
                        (send (car (spawn/chan
                                    (fun (cc) 




From sboukarev at common-lisp.net  Wed Feb 20 17:33:14 2013
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 20 Feb 2013 09:33:14 -0800
Subject: [slime-cvs] CVS slime
Message-ID: <E1U8DXe-0005HE-JE@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv19470

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-attempt-connection): Don't run the timer with a
repeat argument, slime-attempt-connection will reinstantiate the
timer if needed, otherwise it can be a possible source of race
conditions.


--- /project/slime/cvsroot/slime/ChangeLog	2013/02/13 07:27:14	1.2393
+++ /project/slime/cvsroot/slime/ChangeLog	2013/02/20 17:33:14	1.2394
@@ -1,3 +1,10 @@
+2013-02-20  Stas Boukarev  <stassats at gmail.com>
+
+	* slime.el (slime-attempt-connection): Don't run the timer with a
+	repeat argument, slime-attempt-connection will reinstantiate the
+	timer if needed, otherwise it can be a possible source of race
+	conditions.
+
 2013-02-13  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-allegro.lisp (eval-in-frame): debugger:frame-var-name can
--- /project/slime/cvsroot/slime/slime.el	2013/02/13 07:27:14	1.1427
+++ /project/slime/cvsroot/slime/slime.el	2013/02/20 17:33:14	1.1428
@@ -1318,7 +1318,7 @@
   "Start a Swank server in the inferior Lisp and connect."
   (slime-delete-swank-port-file 'quiet)
   (slime-start-swank-server process args)
-  (slime-read-port-and-connect process nil))
+  (slime-read-port-and-connect process))
 
 (defvar slime-inferior-lisp-args nil
   "A buffer local variable in the inferior proccess.
@@ -1376,9 +1376,8 @@
        (message (message "Unable to delete swank port file %S"
                          (slime-swank-port-file)))))))
 
-(defun slime-read-port-and-connect (inferior-process retries)
-  (slime-cancel-connect-retry-timer)
-  (slime-attempt-connection inferior-process retries 1))
+(defun slime-read-port-and-connect (inferior-process)
+  (slime-attempt-connection inferior-process nil 1))
 
 (defun slime-attempt-connection (process retries attempt)
   ;; A small one-state machine to attempt a connection with
@@ -1409,7 +1408,7 @@
            (assert (not slime-connect-retry-timer))
            (setq slime-connect-retry-timer
                  (run-with-timer
-                  0.3 0.3
+                  0.3 nil
                   #'slime-timer-call #'slime-attempt-connection
                   process (and retries (1- retries))
                   (1+ attempt)))))))
@@ -6385,7 +6384,7 @@
   (let ((id (get-text-property (point) 'thread-index))
         (file (slime-swank-port-file)))
     (slime-eval-async `(swank:start-swank-server-in-thread ,id ,file)))
-  (slime-read-port-and-connect nil nil))
+  (slime-read-port-and-connect nil))
 
 (defun slime-thread-debug ()
   (interactive)