From heller at common-lisp.net  Wed Mar  9 20:09:49 2011
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 09 Mar 2011 15:09:49 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1PxPhd-0001sU-4U@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Move some of the logic from slime-sexp-at-point-for-macroexpansion
into slime-sexp-at-point.

* slime.el (slime-bounds-of-sexp-at-point): New.  Special case if
we are at '( as slime-sexp-at-point-for-macroexpansion does.
(slime-bounds-of-symbol-at-point): New.
(slime-symbol-at-point, slime-sexp-at-point): Use the above.

Thank God for the test suite.

--- /project/slime/cvsroot/slime/ChangeLog	2011/02/24 06:38:34	1.2182
+++ /project/slime/cvsroot/slime/ChangeLog	2011/03/09 20:09:48	1.2183
@@ -1,3 +1,13 @@
+2011-03-09  Helmut Eller  <heller at common-lisp.net>
+
+	Move some of the logic from slime-sexp-at-point-for-macroexpansion
+	into slime-sexp-at-point.
+
+	* slime.el (slime-bounds-of-sexp-at-point): New.  Special case if
+	we are at '( as slime-sexp-at-point-for-macroexpansion does.
+	(slime-bounds-of-symbol-at-point): New.
+	(slime-symbol-at-point, slime-sexp-at-point): Use the above.
+
 2011-02-24  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-allegro.lisp (find-topframe): Fix excl::int-newest-frame
--- /project/slime/cvsroot/slime/slime.el	2011/02/18 20:38:41	1.1360
+++ /project/slime/cvsroot/slime/slime.el	2011/03/09 20:09:49	1.1361
@@ -8599,7 +8599,7 @@
 
 (defun slime-beginning-of-symbol ()
   "Move to the beginning of the CL-style symbol at point."
-  (while (re-search-backward "\\(\\sw\\|\\s_\\|\\s\\.\\|\\s\\\\|[#@|]\\)\\=" 
+  (while (re-search-backward "\\(\\sw\\|\\s_\\|\\s\\.\\|\\s\\\\|[#@|]\\)\\="
                              (when (> (point) 2000) (- (point) 2000))
                              t))
   (re-search-forward "\\=#[-+.<|]" nil t)
@@ -8621,19 +8621,40 @@
 (defun slime-symbol-end-pos ()
   (save-excursion (slime-end-of-symbol) (point)))
 
+(defun slime-bounds-of-symbol-at-point ()
+  "Return the bounds of the symbol around point.
+The returned bounds are either nil or non-empty."
+  (let ((bounds (bounds-of-thing-at-point 'slime-symbol)))
+    (if (and bounds
+             (< (car bounds)
+                (cdr bounds)))
+        bounds)))
+
 (defun slime-symbol-at-point ()
   "Return the name of the symbol at point, otherwise nil."
   ;; (thing-at-point 'symbol) returns "" in empty buffers
-  (let ((string (thing-at-point 'slime-symbol)))
-    (and string
-         (not (equal string "")) 
-         (substring-no-properties string))))
+  (let ((bounds (slime-bounds-of-symbol-at-point)))
+    (if bounds
+        (buffer-substring-no-properties (car bounds)
+                                        (cdr bounds)))))
+
+(defun slime-bounds-of-sexp-at-point ()
+  "Return the bounds sexp at point as a pair (or nil)."
+  (or (slime-bounds-of-symbol-at-point)
+      (and (equal (char-after) ?\()
+           (member (char-before) '(?\' ?\, ?\@))
+           ;; hide stuff before ( to avoid quirks with '( etc.
+           (save-restriction
+             (narrow-to-region (point) (point-max))
+             (bounds-of-thing-at-point 'sexp)))
+      (bounds-of-thing-at-point 'sexp)))
 
 (defun slime-sexp-at-point ()
   "Return the sexp at point as a string, otherwise nil."
-  (or (slime-symbol-at-point)
-      (let ((string (thing-at-point 'sexp)))
-        (if string (substring-no-properties string) nil))))
+  (let ((bounds (slime-bounds-of-sexp-at-point)))
+    (if bounds
+        (buffer-substring-no-properties (car bounds)
+                                        (cdr bounds)))))
 
 (defun slime-sexp-at-point-or-error ()
   "Return the sexp at point as a string, othwise signal an error."




From heller at common-lisp.net  Wed Mar  9 20:09:58 2011
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 09 Mar 2011 15:09:58 -0500
Subject: [slime-cvs] CVS slime
Message-ID: <E1PxPhm-0001t2-0X@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Remove slime-sexp-at-point-for-macroexpansion.

* slime.el (slime-sexp-at-point-for-macroexpansion): Deleted.
(slime-eval-macroexpand): Use slime-sexp-at-point instead.
(slime-eval-macroexpand-inplace): Use
slime-bounds-of-sexp-at-point directly.

--- /project/slime/cvsroot/slime/ChangeLog	2011/03/09 20:09:48	1.2183
+++ /project/slime/cvsroot/slime/ChangeLog	2011/03/09 20:09:57	1.2184
@@ -1,5 +1,14 @@
 2011-03-09  Helmut Eller  <heller at common-lisp.net>
 
+	Remove slime-sexp-at-point-for-macroexpansion.
+
+	* slime.el (slime-sexp-at-point-for-macroexpansion): Deleted.
+	(slime-eval-macroexpand): Use slime-sexp-at-point instead.
+	(slime-eval-macroexpand-inplace): Use
+	slime-bounds-of-sexp-at-point directly.
+
+2011-03-09  Helmut Eller  <heller at common-lisp.net>
+
 	Move some of the logic from slime-sexp-at-point-for-macroexpansion
 	into slime-sexp-at-point.
 
--- /project/slime/cvsroot/slime/slime.el	2011/03/09 20:09:49	1.1361
+++ /project/slime/cvsroot/slime/slime.el	2011/03/09 20:09:57	1.1362
@@ -4962,32 +4962,12 @@
         (slime-remove-edits (point-min) (point-max)))
       (undo-only arg))))
 
-(defun slime-sexp-at-point-for-macroexpansion ()
-  "`slime-sexp-at-point' with special cases for LOOP."
-  (let ((string (slime-sexp-at-point-or-error))
-        (bounds (bounds-of-thing-at-point 'sexp))
-        (char-at-point (substring-no-properties (thing-at-point 'char))))
-    ;; SLIME-SEXP-AT-POINT(-OR-ERROR) uses (THING-AT-POINT 'SEXP)
-    ;; which is quite a bit botched: it returns "'(FOO BAR BAZ)" even
-    ;; when point is placed _at the opening parenthesis_, and hence
-    ;; "(FOO BAR BAZ)" wouldn't get expanded. Likewise for ",(...)",
-    ;; ",@(...)" (would return "@(...)"!!), and "\"(...)".
-    ;; So we better fix this up here:
-    (when (string= char-at-point "(")
-      (let ((char0 (elt string 0)))
-        (when (member char0 '(?\' ?\, ?\" ?\@))
-          (setf string (substring string 1))
-          (incf (car bounds)))))
-    (list string (cons (set-marker (make-marker) (car bounds))
-                       (set-marker (make-marker) (cdr bounds))))))
-
 (defvar slime-eval-macroexpand-expression nil
   "Specifies the last macroexpansion preformed. 
 This variable specifies both what was expanded and how.")
 
 (defun slime-eval-macroexpand (expander &optional string)
-  (let ((string (or string
-                    (car (slime-sexp-at-point-for-macroexpansion)))))
+  (let ((string (or string (slime-sexp-at-point))))
     (setq slime-eval-macroexpand-expression `(,expander ,string))
     (slime-eval-async slime-eval-macroexpand-expression
                       #'slime-initialize-macroexpansion-buffer)))
@@ -5024,15 +5004,15 @@
 
 NB: Does not affect slime-eval-macroexpand-expression"
   (interactive)
-  (destructuring-bind (string bounds)
-      (slime-sexp-at-point-for-macroexpansion)
-    (lexical-let* ((start (car bounds))
-                   (end (cdr bounds))
+  (let* ((bounds (or (slime-bounds-of-sexp-at-point) 
+                     (error "No sexp at point"))))
+    (lexical-let* ((start (copy-marker (car bounds)))
+                   (end (copy-marker (cdr bounds)))
                    (point (point))
                    (package (slime-current-package))
                    (buffer (current-buffer)))
       (slime-eval-async 
-       `(,expander ,string)
+       `(,expander ,(buffer-substring-no-properties start end))
        (lambda (expansion)
          (with-current-buffer buffer
            (let ((buffer-read-only nil))
@@ -7695,7 +7675,8 @@
   '(("foo")
     ("#:foo")
     ("#'foo")
-    ("#'(lambda (x) x)"))
+    ("#'(lambda (x) x)")
+    ("()"))
   (with-temp-buffer
     (lisp-mode)
     (insert string)




From heller at common-lisp.net  Wed Mar  9 20:30:37 2011
From: heller at common-lisp.net (CVS User heller)
Date: Wed, 09 Mar 2011 15:30:37 -0500
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1PxQ1l-0003Wx-Ln@common-lisp.net>

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

Modified Files:
	ChangeLog slime-editing-commands.el 
Log Message:
* slime-editing-commands.el (slime-beginning-of-defun): Call
beginning-of-defun with call-interactively so that the mark gets
pushed.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/01/23 00:08:08	1.431
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/03/09 20:30:37	1.432
@@ -1,3 +1,9 @@
+2011-03-09  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-editing-commands.el (slime-beginning-of-defun): Call
+	beginning-of-defun with call-interactively so that the mark gets
+	pushed.
+
 2011-01-22  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-repl.el (slime-repl-shortcut-help): Don't make ? an alias
--- /project/slime/cvsroot/slime/contrib/slime-editing-commands.el	2010/05/13 15:31:07	1.12
+++ /project/slime/cvsroot/slime/contrib/slime-editing-commands.el	2011/03/09 20:30:37	1.13
@@ -17,7 +17,8 @@
   (if (and (boundp 'slime-repl-input-start-mark)
            slime-repl-input-start-mark)
       (slime-repl-beginning-of-defun)
-      (beginning-of-defun)))
+    (let ((this-command 'beginning-of-defun)) ; needed for push-mark
+      (call-interactively 'beginning-of-defun))))
 
 (defun slime-end-of-defun ()
   (interactive)




From sboukarev at common-lisp.net  Sun Mar 13 21:11:13 2011
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sun, 13 Mar 2011 17:11:13 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1PysZF-0007EW-Dr@common-lisp.net>

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (format-restarts-for-emacs): Add
without-printing-errors around restart printing.


--- /project/slime/cvsroot/slime/ChangeLog	2011/03/09 20:09:57	1.2184
+++ /project/slime/cvsroot/slime/ChangeLog	2011/03/13 21:11:12	1.2185
@@ -1,3 +1,8 @@
+2011-03-13  Stas Boukarev  <stassats at gmail.com>
+
+	* swank.lisp (format-restarts-for-emacs): Add
+	without-printing-errors around restart printing.
+
 2011-03-09  Helmut Eller  <heller at common-lisp.net>
 
 	Remove slime-sexp-at-point-for-macroexpansion.
--- /project/slime/cvsroot/slime/swank.lisp	2011/02/04 14:26:45	1.740
+++ /project/slime/cvsroot/slime/swank.lisp	2011/03/13 21:11:13	1.741
@@ -2599,8 +2599,12 @@
     (loop for restart in *sldb-restarts* collect 
           (list (format nil "~:[~;*~]~a" 
                         (eq restart *sldb-quit-restart*)
-                        (restart-name restart) )
-                (princ-to-string restart)))))
+                        (restart-name restart))
+                (with-output-to-string (stream)
+                  (without-printing-errors (:object restart
+                                            :stream stream
+                                            :msg "<<error printing restart>>")
+                    (princ restart stream)))))))
 
 ;;;;; SLDB entry points
 




From sboukarev at common-lisp.net  Sun Mar 13 21:33:54 2011
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sun, 13 Mar 2011 17:33:54 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1PysvC-0000GK-U0@common-lisp.net>

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

Modified Files:
	ChangeLog slime-sprof.el 
Log Message:
* slime-sprof.el(abbreviate-name): Rename to
slime-sprof-abbreviate-name (no package system, oh well...).


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/03/09 20:30:37	1.432
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/03/13 21:33:54	1.433
@@ -1,3 +1,8 @@
+2011-03-13  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-sprof.el(abbreviate-name): Rename to
+	slime-sprof-abbreviate-name (no package system, oh well...).
+
 2011-03-09  Helmut Eller  <heller at common-lisp.net>
 
 	* slime-editing-commands.el (slime-beginning-of-defun): Call
--- /project/slime/cvsroot/slime/contrib/slime-sprof.el	2010/12/10 15:05:06	1.14
+++ /project/slime/cvsroot/slime/contrib/slime-sprof.el	2011/03/13 21:33:54	1.15
@@ -99,7 +99,7 @@
     (slime-insert-propertized
      (slime-sprof-browser-name-properties)
      (format (format "%%-%ds " name-length)
-             (abbreviate-name name name-length)))
+             (slime-sprof-abbreviate-name name name-length)))
     (insert (format "%6.2f " self))
     (when cumul
       (insert (format "%6.2f " cumul))
@@ -110,7 +110,7 @@
        `(profile-index ,index expanded nil)))
     (insert "\n")))
 
-(defun abbreviate-name (name max-length)
+(defun slime-sprof-abbreviate-name (name max-length)
   (lexical-let ((length (min (length name) max-length)))
     (subseq name 0 length)))
 
@@ -166,7 +166,7 @@
            (slime-sprof-browser-name-properties)
            (let ((len (- 59 (* 2 nesting))))
              (format (format "%%-%ds " len)
-                     (abbreviate-name name len))))
+                     (slime-sprof-abbreviate-name name len))))
           (slime-sprof-browser-add-line-text-properties
            `(profile-sub-index ,index))
           (insert (format "%6.2f" cumul)))))))




From sboukarev at common-lisp.net  Mon Mar 14 07:18:36 2011
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Mon, 14 Mar 2011 03:18:36 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1Pz232-0006BN-0W@common-lisp.net>

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

Modified Files:
	ChangeLog swank-sprof.lisp 
Log Message:
* swank-sprof.lisp (swank-sprof-get-call-graph): Don't call
serialize-call-graph when there's no samples. That prevents it
from crashing.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/03/13 21:33:54	1.433
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/03/14 07:18:35	1.434
@@ -1,3 +1,9 @@
+2011-03-14  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-sprof.lisp (swank-sprof-get-call-graph): Don't call
+	serialize-call-graph when there's no samples. That prevents it
+	from crashing.
+
 2011-03-13  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-sprof.el(abbreviate-name): Rename to
--- /project/slime/cvsroot/slime/contrib/swank-sprof.lisp	2010/09/17 20:32:55	1.5
+++ /project/slime/cvsroot/slime/contrib/swank-sprof.lisp	2011/03/14 07:18:35	1.6
@@ -74,8 +74,8 @@
                                       `((nil "Elsewhere" ,rest nil nil)))))))))
 
 (defslimefun swank-sprof-get-call-graph (&key exclude-swank)
-  (setf *call-graph* (sb-sprof:report :type nil))
-  (serialize-call-graph :exclude-swank exclude-swank))
+  (when (setf *call-graph* (sb-sprof:report :type nil))
+    (serialize-call-graph :exclude-swank exclude-swank)))
 
 (defslimefun swank-sprof-expand-node (index)
   (let* ((node (gethash index *number-nodes*)))