[slime-cvs] CVS update: slime/slime.el

[Helmut Eller]

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

Modified Files:
	slime.el 
Log Message:
(slime-find-unbalanced-parenthesis): New command. Bound to C-c C-).
Date: Mon Feb 23 16:13:21 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.214 slime/slime.el:1.215
--- slime/slime.el:1.214	Sat Feb 21 11:34:05 2004
+++ slime/slime.el	Mon Feb 23 16:13:21 2004
@@ -457,6 +457,7 @@
     ;; "Other"
     ("\I"  slime-inspect :prefixed t :inferior t :sldb t)
     ("\C-]" slime-close-all-sexp :prefixed t :inferior t :sldb t)
+    ([(control c) (control \))] slime-find-unbalanced-parenthesis)
     ("\C-xt" slime-list-threads :prefixed t :inferior t :sldb t)
     ("\C-xc" slime-list-connections :prefixed t :inferior t :sldb t)))
 
@@ -4901,6 +4902,39 @@
       (skip-chars-forward " \t\n)")
       (skip-chars-backward " \t\n")
       (delete-region point (point)))))
+
+(defun slime-find-unbalanced-parenthesis ()
+  "Verify that parentheses in the current buffer are balanced.
+If they are not, position point at the first syntax error found."
+  (interactive)
+  (let ((saved-point (point))
+        (state (parse-partial-sexp (point-min) (point-max) -1)))
+    (destructuring-bind (depth innermost-start last-terminated-start
+                               in-string in-comment after-quote 
+                               minimum-depth comment-style 
+                               comment-or-string-start &rest _) state
+      (cond ((and (zerop depth) 
+                  (not in-string) 
+                  (or (not in-comment) 
+                      (and (eq comment-style nil) 
+                           (eobp)))
+                  (not after-quote))
+             (goto-char saved-point)
+             (message "All parentheses appear to be balanced."))
+            ((plusp depth)
+             (goto-char innermost-start)
+             (error "Missing )"))
+            ((minusp depth)
+             (error "Extra )"))
+            (in-string
+             (goto-char comment-or-string-start)
+             (error "String not terminated"))
+            (in-comment
+             (goto-char comment-or-string-start)
+             (error "Comment not terminated"))
+            (after-quote
+             (error "After quote"))
+            (t (error "Shouldn't happen: parsing state: %S" state))))))
 
 ;;; Test suite