Path: utzoo!attcan!uunet!husc6!think!bloom-beacon!mit-eddie!uw-beaver!cornell!rochester!pt.cs.cmu.edu!PROOF.ERGO.CS.CMU.EDU!tsf
From: tsf@PROOF.ERGO.CS.CMU.EDU (Timothy Freeman)
Newsgroups: comp.emacs
Subject: Indenting Labels
Keywords: Common Lisp Labels Indenting
Message-ID: <1694@pt.cs.cmu.edu>
Date: 16 May 88 23:03:11 GMT
Sender: netnews@pt.cs.cmu.edu
Organization: Carnegie-Mellon University, CS/RI
Lines: 77

Here's code to indent Common Lisp's labels construct properly.  It's a
bit slow.  The problem it solves is that a labels construct looks
better when indented like this:

   (labels ((this-is-a-very-long-function-name ()
              stuff)))

than when indented like this:

   (labels ((this-is-a-very-long-function-name ()
                                               stuff)))

I hereby release this into the public domain.

(defun containing-sexp (indent-point)
  (let (state (retry t) last-sexp containing-sexp)
    (save-excursion
      (beginning-of-defun)
      ;; Find outermost containing sexp
      (while (< (point) indent-point)
	(setq state (parse-partial-sexp (point) indent-point 0)))
      ;; Now state is the state of the parser starting at the
      ;; outermost containing sexp for indent-point and ending at indent-point.
      ;; This loop has no side effects on indent-point.
      (while (and retry (car state) (> (car state) 0))
	(setq retry nil)
	(setq last-sexp (nth 2 state))
	(setq containing-sexp (car (cdr state)))
	;; Position following last unclosed open.
	(goto-char (1+ containing-sexp))
	;; Is there a complete sexp since then?
	(if (and last-sexp (> last-sexp (point)))
	    ;; Yes, but is there a containing sexp after that?
	    (let ((peek (parse-partial-sexp last-sexp indent-point 0)))
	      (if (setq retry (car (cdr peek))) (setq state peek)))))
      ;; Now:
      ;;    last-sexp is the start of the last sexp finished before point,
      ;;       nil if none.
      ;;    containing-sexp is the start of the innermost sexp
      ;;       containing indent-point, nil if none.
      ;;    state is the state of the parse from last-sexp to
      ;;       indent-point.  If last-sexp is nil, then state is
      ;;       vacuous.
      ;;    retry is t if indent-point is the first sexp in its
      ;;       containing sexp.
      containing-sexp)))

(defun in-labels-p (place)
  "Returns t if we are in the place where we need to indent specially
for labels."
  (save-excursion
    (let ((cont1 (containing-sexp place)))
      (and cont1
	   (let ((cont2 (containing-sexp cont1)))
	     (and cont2
		  (progn
		    (goto-char cont2)
		    (looking-at "(("))
		  (let ((cont3 (containing-sexp cont2)))
		    (goto-char cont3)
		    (or (looking-at "(labels")
			(looking-at "(flet")))))))))

(defun new-lisp-indent-hook (indent-point state)
  (if (in-labels-p indent-point)
      (+ lisp-body-indent
	 (save-excursion
	   (goto-char (car (cdr state)))
	   (current-column)))
      (lisp-indent-hook indent-point state)))

(setq lisp-indent-hook 'new-lisp-indent-hook)
-- 
Tim Freeman

Arpanet: tsf@theory.cs.cmu.edu
Uucp:    ...!seismo.css.gov!proof.ergo.cs.cmu.edu!tsf