[slime-cvs] CVS slime/contrib

[trittweiler]

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

Modified Files:
	slime-parse.el slime-enclosing-context.el ChangeLog 
Log Message:

	* slime-parse.el (slime-has-symbol-syntax-p): New.
	(slime-parse-symbol-name-at-point): New; works on top of
	`slime-parse-sexp-at-point'.
	(slime-enclosing-form-specs): Use it.

	* slime-enclosing-context.el (slime-find-bound-names): Use
	`slime-parse-symbol-name-at-point'.
	(slime-find-bound-functions): Ditto.
	(def-slime-test enclosing-context.1): New test case. Thanks to
	John Pallister for reporting this bug.


--- /project/slime/cvsroot/slime/contrib/slime-parse.el	2008/06/07 11:46:06	1.11
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el	2008/09/13 10:39:02	1.12
@@ -63,6 +63,17 @@
               (first result)
               (nreverse result)))))))
 
+(defun slime-has-symbol-syntax-p (string)
+  (if (and string (not (zerop (length string))))
+      (member (char-syntax (aref string 0)) 
+	      '(?w ?_ ?\' ?\\))))
+
+(defun slime-parse-symbol-name-at-point (&optional n skip-blanks-p)
+  (let ((symbols (slime-parse-sexp-at-point n skip-blanks-p)))
+    (if (every #'slime-has-symbol-syntax-p (slime-ensure-list symbols))
+	symbols
+	nil)))
+
 (defun slime-incomplete-sexp-at-point (&optional n)
   (interactive "p") (or n (setq n 1))
   (buffer-substring-no-properties (save-excursion (backward-up-list n) (point))
@@ -291,16 +302,17 @@
               (when (member (char-syntax (char-after)) '(?\( ?')) 
                 (incf level)
                 (forward-char 1)
-                (let ((name (slime-symbol-name-at-point)))
+                (let ((name (slime-parse-symbol-name-at-point 1 nil)))
                   (cond
                     (name
                      (save-restriction
                        (widen) ; to allow looking-ahead/back in extended parsing.
                        (multiple-value-bind (new-result new-indices new-points)
-                           (slime-parse-extended-operator-name initial-point
-                                                               (cons `(,name) result) ; minimal form spec
-                                                               (cons arg-index arg-indices)
-                                                               (cons (point) points))
+                           (slime-parse-extended-operator-name 
+			    initial-point
+			    (cons `(,name) result) ; minimal form spec
+			    (cons arg-index arg-indices)
+			    (cons (point) points))
                          (setq result new-result)
                          (setq arg-indices new-indices)
                          (setq points new-points))))
--- /project/slime/cvsroot/slime/contrib/slime-enclosing-context.el	2008/09/07 12:24:37	1.1
+++ /project/slime/cvsroot/slime/contrib/slime-enclosing-context.el	2008/09/13 10:39:02	1.2
@@ -54,7 +54,7 @@
 		 (ignore-errors
 		   (loop 
 		    (down-list) 
-		    (push (slime-symbol-name-at-point) binding-names)
+		    (push (slime-parse-symbol-name-at-point 1) binding-names)
 		    (push (save-excursion (backward-up-list) (point)) 
 			  binding-start-points)
 		    (up-list)))))
@@ -79,14 +79,47 @@
 		 (ignore-errors
 		   (loop 
 		    (down-list) 
-		    (push (slime-symbol-name-at-point) names)
-		    (slime-end-of-symbol) 
-		    (push (slime-parse-sexp-at-point 1 t) arglists)
-		    (push (save-excursion (backward-up-list) (point)) 
-			  start-points)
+		    (destructuring-bind (name arglist)
+			(slime-ensure-list (slime-parse-sexp-at-point 2))
+		      (assert (slime-has-symbol-syntax-p name)) (assert arglist)
+		      (push name names)
+		      (push arglist arglists)
+		      (push (save-excursion (backward-up-list) (point)) 
+			    start-points))
 		    (up-list)))))
       (values (nreverse names)
 	      (nreverse arglists) 
 	      (nreverse start-points)))))
 
+
+(def-slime-test enclosing-context.1
+    (buffer-sexpr wished-bound-names wished-bound-functions)
+    "Check that finding local definitions work."
+    '(("(flet ((,nil ()))
+	 (let ((bar 13)
+	       (,foo 42))
+	   *HERE*))" 
+       (",nil" "bar" ",foo")
+       ((",nil" "()"))))
+  (slime-check-top-level)
+  (with-temp-buffer
+    (let ((tmpbuf (current-buffer)))
+      (lisp-mode)
+      (insert buffer-sexpr)
+      (search-backward "*HERE*")
+      (multiple-value-bind (bound-names points) 
+	  (slime-enclosing-bound-names)
+	(slime-check "Check enclosing bound names"
+	  (loop for name in wished-bound-names
+		always (member name bound-names))))
+      (multiple-value-bind (fn-names fn-arglists points) 
+	  (slime-enclosing-bound-functions)
+	(slime-check "Check enclosing bound functions"
+	  (loop for (name arglist) in wished-bound-functions
+		always (and (member name fn-names)
+			    (member arglist fn-arglists)))))
+      )))
+
+
+
 (provide 'slime-enclosing-context)
\ No newline at end of file
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/09/10 23:51:17	1.129
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/09/13 10:39:02	1.130
@@ -1,3 +1,16 @@
+2008-09-13  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-parse.el (slime-has-symbol-syntax-p): New.
+	(slime-parse-symbol-name-at-point): New; works on top of
+	`slime-parse-sexp-at-point'.
+	(slime-enclosing-form-specs): Use it.
+
+	* slime-enclosing-context.el (slime-find-bound-names): Use
+	`slime-parse-symbol-name-at-point'.
+	(slime-find-bound-functions): Ditto.
+	(def-slime-test enclosing-context.1): New test case. Thanks to
+	John Pallister for reporting this bug.
+
 2008-09-11  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-asdf.lisp (operate-on-system-for-emacs): Adapted to recent