[slime-cvs] CVS slime/contrib

trittweiler trittweiler at common-lisp.net
Thu Aug 7 14:49:51 UTC 2008


Update of /project/slime/cvsroot/slime/contrib
In directory clnet:/tmp/cvs-serv5053/contrib

Modified Files:
	slime-mdot-fu.el ChangeLog 
Log Message:

* slime-mdot-fu.el: Works for LET bindings now also.
  (def-slime-test find-local-definitions.1): New test case.


--- /project/slime/cvsroot/slime/contrib/slime-mdot-fu.el	2008/07/31 08:37:22	1.1
+++ /project/slime/cvsroot/slime/contrib/slime-mdot-fu.el	2008/08/07 14:49:51	1.2
@@ -10,7 +10,8 @@
 (defvar slime-binding-ops-alist
   '((flet &bindings &body) 
     (labels &bindings &body)
-    (macrolet &bindings &body)))
+    (macrolet &bindings &body)
+    (let &bindings &body)))
 
 (defun slime-lookup-binding-op (op)
   (assoc* op slime-binding-ops-alist :test 'equalp :key 'symbol-name))
@@ -75,6 +76,48 @@
   (remove-hook 'slime-edit-definition-hooks 
 	       'slime-edit-local-definition))
 
+
+
+(def-slime-test find-local-definitions.1
+    (buffer-sexpr definition target-regexp)
+    "Check that finding local definitions work."
+    '(((defun foo (x)
+	  (let ((y (+ x 1)))
+	    (- x y *HERE*)))
+       y
+       "(y (+ x 1))")
+
+      ((defun bar (x)
+	 (flet ((foo (z) (+ x z)))
+	   (* x (foo *HERE*))))
+       foo
+       "(foo (z) (+ x z))")
+
+      ((defun quux (x)
+	 (flet ((foo (z) (+ x z)))
+	   (let ((foo (- 1 x)))
+	     (+ x foo *HERE*))))
+       foo
+       "(foo (- 1 x)")
+      
+      ((defun zurp (x)
+	 (macrolet ((frob (x y) `(quux ,x ,y)))
+	   (frob x *HERE*)))
+       frob
+       "(frob (x y)"))
+  (slime-check-top-level)
+  (with-temp-buffer
+    (let ((tmpbuf (current-buffer)))
+      (insert (prin1-to-string buffer-sexpr))
+      (search-backward "*HERE*")
+      (slime-edit-local-definition (prin1-to-string definition))
+      (slime-sync)
+      (slime-check "Check that we didnt leave the temp buffer." 
+	(eq (current-buffer) tmpbuf))
+      (slime-check "Check that we are at the local definition."
+	(looking-at (regexp-quote target-regexp))))))
+
+
 (provide 'slime-mdot-fu)
 
 
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/08/05 18:19:34	1.115
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/08/07 14:49:51	1.116
@@ -1,3 +1,8 @@
+2008-08-07  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-mdot-fu.el: Works for LET bindings now also.
+	(def-slime-test find-local-definitions.1): New test case.
+
 2008-08-05  Michael Weber  <michaelw+slime at foldr.org>
 
 	* slime-typeout-frame.el (slime-typeout-message-aux): prevent




More information about the slime-cvs mailing list