[slime-cvs] CVS slime/contrib

[CVS User trittweiler]

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

Modified Files:
	ChangeLog slime-parse.el 
Log Message:
	* slime-parse.el (slime-make-extended-operator-parser/look-ahead):
	If there's no closing paren (no paredit!) we cannot determine the
	end of the list. Check for this.
	([test] enclosing-form-specs.1): Extend test case.
	(slime-check-enclosing-form-specs): New helper.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/02/26 22:44:36	1.178
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/02/27 16:26:24	1.179
@@ -1,3 +1,11 @@
+2009-02-27  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-parse.el (slime-make-extended-operator-parser/look-ahead):
+	If there's no closing paren (no paredit!) we cannot determine the
+	end of the list. Check for this.
+	([test] enclosing-form-specs.1): Extend test case.
+	(slime-check-enclosing-form-specs): New helper.
+
 2009-02-26  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-fancy-inspector.lisp (emacs-inspect (stream-error)): Do
--- /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/02/26 18:35:43	1.16
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/02/27 16:26:24	1.17
@@ -119,8 +119,9 @@
               (arg-idx   (first current-indices)))
           (when (and (not (zerop arg-idx)) ; point is at CAR of form?
                      (not (= (point)       ; point is at end of form?
-                             (save-excursion (slime-end-of-list)
-                                             (point)))))
+                             (save-excursion
+                               (ignore-errors (slime-end-of-list))
+                               (point)))))
             (let* ((args (slime-parse-sexp-at-point n))
                    (arg-specs (mapcar #'slime-make-form-spec-from-string args)))
               (setq current-forms (cons `(,name , at arg-specs) old-forms))))
@@ -268,9 +269,9 @@
       (save-excursion
         ;; Make sure we get the whole thing at point.
         (if (not (slime-inside-string-p))
-	    (slime-end-of-symbol)
-	  (slime-beginning-of-string)
-	  (forward-sexp))
+            (slime-end-of-symbol)
+          (slime-beginning-of-string)
+          (forward-sexp))
         (save-restriction
           ;; Don't parse more than 20000 characters before point, so we don't spend
           ;; too much time.
@@ -301,10 +302,10 @@
                        (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))
+                            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))))
@@ -333,15 +334,32 @@
         (goto-char string-start-pos)
         (error "We're not within a string"))))
 
+
+;;;; Test cases
+
+(defun slime-check-enclosing-form-specs (wished-form-specs)
+  (multiple-value-bind (specs) 
+      (slime-enclosing-form-specs)
+    (slime-check 
+        ("Check enclosing form specs in `%s' (%d)" (buffer-string) (point))
+      (equal specs wished-form-specs))))
+
 (def-slime-test enclosing-form-specs.1
     (buffer-sexpr wished-form-specs)
-    ""
-    '(("(defun *HERE*"           (("defun")))
-      ("(defun foo *HERE*"       (("defun")))
-      ("(defun foo (x y) *HERE*" (("defun")))
-      ("(defmethod *HERE*)"      (("defmethod")))
-      ("(defmethod foo *HERE*)"  (("defmethod" "foo")))
-      ("(cerror foo *HERE*)"     (("cerror" "foo"))))
+    "Check that we correctly determine enclosing forms."
+    '(("(defun *HERE*"                (("defun")))
+      ("(defun foo *HERE*"            (("defun")))
+      ("(defun foo (x y) *HERE*"      (("defun")))
+      ("(defmethod *HERE*"            (("defmethod")))
+      ("(defmethod foo *HERE*"        (("defmethod" "foo")))
+      ("(cerror foo *HERE*"           (("cerror" "foo")))
+      ("(cerror foo bar *HERE*"       (("cerror" "foo" "bar")))
+      ("(make-instance foo *HERE*"    (("make-instance" "foo")))
+      ("(declare *HERE*"              (("declare")))
+      ("(declare (optimize *HERE*"    ((:declaration ("optimize")) ("declare")))
+      ("(declare (string *HERE*"      ((:declaration ("string")) ("declare")))
+      ("(declare ((vector *HERE*"     ((:type-specifier ("vector"))))
+      ("(declare ((vector bit *HERE*" ((:type-specifier ("vector" "bit")))))
   (slime-check-top-level)
   (with-temp-buffer
     (let ((tmpbuf (current-buffer)))
@@ -349,12 +367,12 @@
       (insert buffer-sexpr)
       (search-backward "*HERE*")
       (delete-region (match-beginning 0) (match-end 0))
-      (multiple-value-bind (specs) 
-	  (slime-enclosing-form-specs)
-	(slime-check "Check enclosing form specs"
-	  (equal specs wished-form-specs)))
+      (slime-check-enclosing-form-specs wished-form-specs)
+      (insert ")") (backward-char)
+      (slime-check-enclosing-form-specs wished-form-specs)      
       )))
 
 
+
 (provide 'slime-parse)