(defvar *slime-comment-start-regexp*
  "\\(\\(^\\|[^\n\\\\]\\)\\([\\\\][\\\\]\\)*\\);+[ \t]*"
  "Regexp to match the start of a comment.")

(defun slime-beginning-of-comment ()
  "Move point to beginning of comment.
If point is inside a comment move to beginning of comment and return point.
Otherwise leave point unchanged and return NIL."
  (let ((boundary (point)))
    (beginning-of-line)
    (cond ((re-search-forward *slime-comment-start-regexp* boundary t)
	   (point))
	  (t (goto-char boundary) 
	     nil))))

(defun slime-close-all-sexp (&optional beg end)
  "Balance parentheses of open s-expressions at point.
Insert enough right parentheses to balance unmatched left parentheses.
Delete extra left parentheses.  Reformat trailing parentheses 
Lisp-stylishly.

If buffer positions BEG and END are given, operate on this region.
Otherwise, if region is active, operate on region.
Otherwise, bound operation by top-level s-expressions or comment at
first column."
  (interactive)
  (let ((sexp-level 0)
	point)
    (save-excursion
      (save-restriction
	;; operate on region if active
	(ignore-errors
	  (narrow-to-region (or beg (mark)) (or end (point)))
	  (goto-char (point-max)))
	;; skip over closing parens, but not into comment
	(skip-chars-backward ") \t\n")
	(when (slime-beginning-of-comment)
	  (forward-line)
	  (skip-chars-forward " \t"))
	(setq point (point))
	;; count sexps until either '(' or comment is found at first column
	(while (and (not (looking-at "^[(;]"))
		  (ignore-errors (backward-up-list 1) t))
	  (incf sexp-level))))
    (when (> sexp-level 0)
      ;; insert correct number of right parens
      (goto-char point)
      (dotimes (i sexp-level) (insert ")"))
      ;; delete extra right parens
      (setq point (point))
      (skip-chars-forward " \t\n)")
      (skip-chars-backward " \t\n")
      (delete-region point (point)))))