;;; Copyright (C) 1990  Alan M. Carroll
;;;
;;; This file is for use with Epoch, a modified version of GNU Emacs.
;;; Requires Epoch 3.2 or later.
;;;
;;; This code is distributed in the hope that it will be useful,
;;; bute WITHOUT ANY WARRANTY. No author or distributor accepts
;;; responsibility to anyone for the consequences of using this code
;;; or for whether it serves any particular purpose or works at all,
;;; unless explicitly stated in a written agreement.
;;;
;;; Everyone is granted permission to copy, modify and redistribute
;;; this code, but only under the conditions described in the
;;; GNU Emacs General Public License, except the original author nor his
;;; agents are bound by the License in their use of this code.
;;; (These special rights for the author in no way restrict the rights of
;;;  others given in the License or this prologue)
;;; A copy of this license is supposed to have been given to you along
;;; with Epoch so you can know your rights and responsibilities. 
;;; It should be in a file named COPYING.  Among other things, the
;;; copyright notice and this notice must be preserved on all copies. 
;;;

(defvar lisp-indent-level 2
  "*Indentation of Lisp Statements per pending open paren."
)

(defvar lisp-auto-newline t
  "*Automatically put excess closing parens on the next line."
)

(defun calculate-lisp-indent (&optional parse-start)
  "Return appropriate indentation for current line as Lisp code.
Lines are indented by a constant times the number of pending
open parens, not counting characters on the line except for
leading close parens (so open/close pairs line up in columns).[amc]"
  (save-excursion
    (beginning-of-line)
    (skip-chars-forward " \t)")
    (let
      ;; vars
      (
	(indent-point (point))		; where we started
	state				; parse state holder
      )
      ;; body
      ;; Find outermost containing sexp
      (if parse-start
	(goto-char parse-start)
	(beginning-of-defun)
      )
      ; How many outstanding open parens?
      ; parse sexp's up to the start of the line
      (setq state (parse-partial-sexp (point) indent-point))
      
      ; we should now be able to calc the indent depth -
      ; the rule is, lisp-indent-level * paren depth, unless in
      ; a string, or starting char is a close-paren
      
      ; get to first non-blank on the indent line
      (goto-char indent-point)
      (skip-chars-forward " \t")
      
      ;; calculate the return value
      (if (elt state 3)			; non-nil if inside a string
	;; then
	(current-column)		; don't change anything
	;; else
	;; use paren depth unless first char is a close-paren
	;; state[0] is the paren nesting depth
	(* lisp-indent-level
	  (- (elt state 0) (if (looking-at ")") 1 0))
)))))
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; this will be attached to the paren characters, and executed whenever
; they are typed. this version automatically puts excess closes on the
; next line if lisp-auto-newline is set. If you never want it set, you
; can remove the entire and clause from the cond

(defun electric-lisp-paren ()
  "Insert character and correct line's indentation for LISP.[amc]"
  (interactive)
  (let
    ;; vars
    (
      ; flags for various conditions
      (first-on-line (save-excursion (skip-chars-backward " \t") (bolp)))
      (here (point))
      state
      start-of-line
      only-closes
    )
    
    ;; body
    ; need to check if we are in a comment or a string
    ; state[3] != nil if in string, and state[4] != nil if in comment
    ; so we parse from the start of the line to where the key was pressed
    (setq state
      (save-excursion
	(beginning-of-line)
	(setq start-of-line (point))
	(setq only-closes
	  (and
	    (= last-command-char ?\))
	    (looking-at "[ \t)]*)[ \t)]*$")
	))
	(parse-partial-sexp (point) here)
    ))
    
    (cond
      
      ; if in a string or a comment just insert the char
      ((or (elt state 3) (elt state 4))
	(insert-char last-command-char 1) ; might as well blow off the blink
      )
      
      ; if first paren on the line, put it in and indent the line
      ((and first-on-line (not only-closes))
	(insert-char last-command-char 1) ; avoid the match blink here
	(lisp-indent-line)		; indent the line
	(funcall blink-paren-hook)	; now do the blink
      )
      
      ; if the auto-flag is set, and it was a closing paren at
      ; the end of the line
      ((and
	  lisp-auto-newline
	  (= last-command-char ?\) )
	  (or (eolp) only-closes)
	)
	;; then check to see if this is an excess close, and if so
	;; put the new close paren on the next line
	(if only-closes (end-of-line))	;put it at the end of the line
	;; parse from beginning of line to the end, to see how paren depth
	(setq state (parse-partial-sexp start-of-line (point)))
	;; state[0] now has the paren depth for the line
	(if (<= (elt state 0) 0)	; no pending opens on this line
	  ;; then
	  (progn
	    (if (not (and (eq lisp-auto-newline t) only-closes))
	      (newline)			; put in the new line
	    )
	    (insert-char ?\) 1)	; now the closing paren
	    (lisp-indent-line)	; indent it
	    (funcall blink-paren-hook) ; do the blink
	  )
	  ;; else
	  (self-insert-command 1)	; not enough closes, put in-line
	) ; if
      )
      ;; if no special conditions, just insert the character
      (t (self-insert-command 1))
    ) ; cond
  ) ; let
)
;;; --------------------------------------------------------------------------
(defun set-lisp-indent-of-line (depth)
"Set the indentation of a lisp to the correct value for DEPTH"
  (save-excursion
    (beginning-of-line)
    (let ((bol (point)))
      (skip-chars-forward " \t")
      (delete-region bol (point))
    )
    (indent-to-column
      (+
	base				;what is this? where is it set?
;;;      (if (looking-at ")") (- lisp-indent-level) 0)
	(* (nth 0 state) lisp-indent-level)
      )
    )
  )
)
;;; --------------------------------------------------------------------------
;;; This version doesn't break up extra multiple close parens...maybe I can
;;; live with that.
(defun amcize-sexp (&optional brutal)
  "Indent the following S-expression. If the optional flag BRUTAL is non nil, then groups of parentheses are broken up."
  (interactive)
  (message "Indenting...")
  (save-excursion (forward-sexp 1))	; check for complete sexp
  (lisp-indent-line)			; fix up this line
  (let
    (
      (base (current-indentation))
      (state nil)
      (old-state (list 0))
      old-pos
      bol
      (here (point))
    )
    (while
      (and
	(not (eobp))
	(or (not state) (> (nth 0 state) 0))
      )
      ;; parse up to end of line
      (setq old-pos (point))		;save location
;;;
;      (setq state
;	(parse-partial-sexp
;	  (point) (save-excursion (end-of-line) (point)) nil nil state
;	)
;      )
;      (forward-char 1)			;goto the next line
;      (setq bol (point))
      (end-of-line) (forward-char 1) (skip-chars-forward " \t)")
      (setq bol (point))
      (setq state (parse-partial-sexp old-pos (point) nil nil state))
;;;
      (setcar (nthcdr 4 state) nil)	;clear in comment flag
      ;; deal with the parse results
      (cond
	((nth 3 state) )		; inside a string
	((looking-at ";") )		; comment at start of line
	;; More than 1 unclosed open paren on a line
	((and brutal (> (car state) (+ 1 (car old-state))))
	  ;;want to allow the special case of multiple opens at the start of
	  ;;a line
	  (let
	    (
	      (this-pos (point))	;save where we are
	      tmp-state
	    )
	    (goto-char old-pos)		;go back
	    (skip-chars-forward " \t")	;skip leading whitespace
	    (skip-chars-forward "(")	;skip leading open parens
	    (save-excursion		;check to see if still extra opens
	      (setq tmp-state (parse-partial-sexp (point) this-pos))
	    )
	    (if (< 0 (car tmp-state))	;yep, still extra opens
	      (progn			;so break them up
		(parse-partial-sexp (point) this-pos 1)	;find first extra
		(forward-char -1)		;back up over it
		(insert "\n")			;put in the newline
		(goto-char old-pos)		;restore to known valid state
		(setq state old-state)
	      )
	      ;; ELSE only starting opens, so just set the indent
	      (progn
		(goto-char this-pos)
		(set-lisp-indent-of-line (car state))
	      )
	    )
	  )
	)
	((and brutal (< (car state) (car old-state)) (nth 2 state))
	  ;; extra close parens plus an sexp
	  (goto-char (nth 2 state))
	  (forward-sexp 1)
	  (insert "\n")
	  (goto-char old-pos)		;restore known valid state
	  (setq state old-state)
	)
	((and brutal (< (+ 1 (car state)) (car old-state)) )
	  ;; multiple extra close parens and no sexp
	  (parse-partial-sexp old-pos (point) -2)
	  (forward-char -1)
	  (insert "\n")
	  (goto-char old-pos)		;restore known valid state
	  (setq state old-state)
	)
	(t (set-lisp-indent-of-line (nth 0 state)))
      )
      (setq old-state state)		;save this state
    )
    (goto-char here)			;restore old point
  )
  (message "Indenting...done")
)

(defun indent-sexp () (interactive) (amcize-sexp nil))
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;
; this function installs the electric paren function on the paren keys
(defun amc-emacs-lisp-hook ()
  (define-key emacs-lisp-mode-map "(" 'electric-lisp-paren)
  (define-key emacs-lisp-mode-map ")" 'electric-lisp-paren)
)
; this function installs the electric paren function on the paren keys
(defun amc-lisp-hook ()
  (define-key lisp-mode-map "(" 'electric-lisp-paren)
  (define-key lisp-mode-map ")" 'electric-lisp-paren)
)
; now set the hook to activate them when entering emacs-lisp-mode
(setq emacs-lisp-mode-hook 'amc-emacs-lisp-hook)
(setq lisp-mode-hook 'amc-lisp-hook)
