scheme.el

早期freebsd实现

		      ;; Indent beneath first argument or, if only one sexp
		      ;; on line, indent beneath that.
		      (progn (forward-sexp 1)
			     (parse-partial-sexp (point) last-sexp 0 t)))
		  (backward-prefix-chars))
		 (t
		  ;; Indent beneath first sexp on same line as last-sexp.
		  ;; Again, it's almost certainly a function call.
		  (goto-char last-sexp)
		  (beginning-of-line)
		  (parse-partial-sexp (point) last-sexp 0 t)
		  (backward-prefix-chars)))))))
      ;; If looking at a list, don't call hook.
      (if first-sexp-list-p
	  (setq desired-indent (current-column)))
      ;; Point is at the point to indent under unless we are inside a string.
      ;; Call indentation hook except when overriden by scheme-indent-offset
      ;; or if the desired indentation has already been computed.
      (cond ((car (nthcdr 3 state))
	     ;; Inside a string, don't change indentation.
	     (goto-char indent-point)
	     (skip-chars-forward " \t")
	     (setq desired-indent (current-column)))
	    ((and (integerp scheme-indent-offset) containing-sexp)
	     ;; Indent by constant offset
	     (goto-char containing-sexp)
	     (setq desired-indent (+ scheme-indent-offset (current-column))))
	    ((not (or desired-indent
		      (and (boundp 'scheme-indent-hook)
			   scheme-indent-hook
			   (not retry)
			   (setq desired-indent
				 (funcall scheme-indent-hook
					  indent-point state)))))
	     ;; Use default indentation if not computed yet
	     (setq desired-indent (current-column))))
      desired-indent)))

(defun scheme-indent-hook (indent-point state)
  (let ((normal-indent (current-column)))
    (save-excursion
      (goto-char (1+ (car (cdr state))))
      (re-search-forward "\\sw\\|\\s_")
      (if (/= (point) (car (cdr state)))
	  (let ((function (buffer-substring (progn (forward-char -1) (point))
					    (progn (forward-sexp 1) (point))))
		method)
	    ;; Who cares about this, really?
	    ;(if (not (string-match "\\\\\\||" function)))
	    (setq function (downcase function))
	    (setq method (get (intern-soft function) 'scheme-indent-hook))
	    (cond ((integerp method)
		   (scheme-indent-specform method state indent-point))
		  (method
		   (funcall method state indent-point))
		  ((and (> (length function) 3)
			(string-equal (substring function 0 3) "def"))
		   (scheme-indent-defform state indent-point))))))))

(defvar scheme-body-indent 2 "")

(defun scheme-indent-specform (count state indent-point)
  (let ((containing-form-start (car (cdr state))) (i count)
	body-indent containing-form-column)
    ;; Move to the start of containing form, calculate indentation
    ;; to use for non-distinguished forms (> count), and move past the
    ;; function symbol.  scheme-indent-hook guarantees that there is at
    ;; least one word or symbol character following open paren of containing
    ;; form.
    (goto-char containing-form-start)
    (setq containing-form-column (current-column))
    (setq body-indent (+ scheme-body-indent containing-form-column))
    (forward-char 1)
    (forward-sexp 1)
    ;; Now find the start of the last form.
    (parse-partial-sexp (point) indent-point 1 t)
    (while (and (< (point) indent-point)
		(condition-case nil
		    (progn
		      (setq count (1- count))
		      (forward-sexp 1)
		      (parse-partial-sexp (point) indent-point 1 t))
		  (error nil))))
    ;; Point is sitting on first character of last (or count) sexp.
    (cond ((> count 0)
	   ;; A distinguished form.  Use double scheme-body-indent.
	   (list (+ containing-form-column (* 2 scheme-body-indent))
		 containing-form-start))
	  ;; A non-distinguished form. Use body-indent if there are no
	  ;; distinguished forms and this is the first undistinguished
	  ;; form, or if this is the first undistinguished form and
	  ;; the preceding distinguished form has indentation at least
	  ;; as great as body-indent.
	  ((and (= count 0)
		(or (= i 0)
		    (<= body-indent normal-indent)))
	   body-indent)
	  (t
	   normal-indent))))

(defun scheme-indent-defform (state indent-point)
  (goto-char (car (cdr state)))
  (forward-line 1)
  (if (> (point) (car (cdr (cdr state))))
      (progn
	(goto-char (car (cdr state)))
	(+ scheme-body-indent (current-column)))))

;;; Let is different in Scheme

(defun would-be-symbol (string)
  (not (string-equal (substring string 0 1) "(")))

(defun next-sexp-as-string ()
  ;; Assumes that protected by a save-excursion
  (forward-sexp 1)
  (let ((the-end (point)))
    (backward-sexp 1)
    (buffer-substring (point) the-end)))

;; This is correct but too slow.
;; The one below works almost always.
;;(defun scheme-let-indent (state indent-point)
;;  (if (would-be-symbol (next-sexp-as-string))
;;      (scheme-indent-specform 2 state indent-point)
;;      (scheme-indent-specform 1 state indent-point)))

(defun scheme-let-indent (state indent-point)
  (skip-chars-forward " \t")
  (if (looking-at "[a-zA-Z0-9+-*/?!@$%^&_:~]")
      (scheme-indent-specform 2 state indent-point)
      (scheme-indent-specform 1 state indent-point)))

;; (put 'begin 'scheme-indent-hook 0), say, causes begin to be indented
;; like defun if the first form is placed on the next line, otherwise
;; it is indented like any other form (i.e. forms line up under first).

(put 'begin 'scheme-indent-hook 0)
(put 'case 'scheme-indent-hook 1)
(put 'delay 'scheme-indent-hook 0)
(put 'do 'scheme-indent-hook 2)
(put 'lambda 'scheme-indent-hook 1)
(put 'let 'scheme-indent-hook 'scheme-let-indent)
(put 'let* 'scheme-indent-hook 1)
(put 'letrec 'scheme-indent-hook 1)
(put 'sequence 'scheme-indent-hook 0)

(put 'call-with-input-file 'scheme-indent-hook 1)
(put 'with-input-from-file 'scheme-indent-hook 1)
(put 'with-input-from-port 'scheme-indent-hook 1)
(put 'call-with-output-file 'scheme-indent-hook 1)
(put 'with-output-to-file 'scheme-indent-hook 1)
(put 'with-output-to-port 'scheme-indent-hook 1)

;;;; MIT Scheme specific indentation.

(if scheme-mit-dialect
    (progn
      (put 'fluid-let 'scheme-indent-hook 1)
      (put 'in-package 'scheme-indent-hook 1)
      (put 'let-syntax 'scheme-indent-hook 1)
      (put 'local-declare 'scheme-indent-hook 1)
      (put 'macro 'scheme-indent-hook 1)
      (put 'make-environment 'scheme-indent-hook 0)
      (put 'named-lambda 'scheme-indent-hook 1)
      (put 'using-syntax 'scheme-indent-hook 1)

      (put 'with-input-from-string 'scheme-indent-hook 1)
      (put 'with-output-to-string 'scheme-indent-hook 0)
      (put 'with-values 'scheme-indent-hook 1)

      (put 'syntax-table-define 'scheme-indent-hook 2)
      (put 'list-transform-positive 'scheme-indent-hook 1)
      (put 'list-transform-negative 'scheme-indent-hook 1)
      (put 'list-search-positive 'scheme-indent-hook 1)
      (put 'list-search-negative 'scheme-indent-hook 1)

      (put 'access-components 'scheme-indent-hook 1)
      (put 'assignment-components 'scheme-indent-hook 1)
      (put 'combination-components 'scheme-indent-hook 1)
      (put 'comment-components 'scheme-indent-hook 1)
      (put 'conditional-components 'scheme-indent-hook 1)
      (put 'disjunction-components 'scheme-indent-hook 1)
      (put 'declaration-components 'scheme-indent-hook 1)
      (put 'definition-components 'scheme-indent-hook 1)
      (put 'delay-components 'scheme-indent-hook 1)
      (put 'in-package-components 'scheme-indent-hook 1)
      (put 'lambda-components 'scheme-indent-hook 1)
      (put 'lambda-components* 'scheme-indent-hook 1)
      (put 'lambda-components** 'scheme-indent-hook 1)
      (put 'open-block-components 'scheme-indent-hook 1)
      (put 'pathname-components 'scheme-indent-hook 1)
      (put 'procedure-components 'scheme-indent-hook 1)
      (put 'sequence-components 'scheme-indent-hook 1)
      (put 'unassigned\?-components 'scheme-indent-hook 1)
      (put 'unbound\?-components 'scheme-indent-hook 1)
      (put 'variable-components 'scheme-indent-hook 1)))

(defun scheme-indent-sexp ()
  "Indent each line of the list starting just after point."
  (interactive)
  (let ((indent-stack (list nil)) (next-depth 0) bol
	outer-loop-done inner-loop-done state this-indent)
    (save-excursion (forward-sexp 1))
    (save-excursion
      (setq outer-loop-done nil)
      (while (not outer-loop-done)
	(setq last-depth next-depth
	      innerloop-done nil)
	(while (and (not innerloop-done)
		    (not (setq outer-loop-done (eobp))))
	  (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
					  nil nil state))
	  (setq next-depth (car state))
	  (if (car (nthcdr 4 state))
	      (progn (indent-for-comment)
		     (end-of-line)
		     (setcar (nthcdr 4 state) nil)))
	  (if (car (nthcdr 3 state))
	      (progn
		(forward-line 1)
		(setcar (nthcdr 5 state) nil))
	    (setq innerloop-done t)))
	(if (setq outer-loop-done (<= next-depth 0))
	    nil
	  (while (> last-depth next-depth)
	    (setq indent-stack (cdr indent-stack)
		  last-depth (1- last-depth)))
	  (while (< last-depth next-depth)
	    (setq indent-stack (cons nil indent-stack)
		  last-depth (1+ last-depth)))
	  (forward-line 1)
	  (setq bol (point))
	  (skip-chars-forward " \t")
	  (if (or (eobp) (looking-at "[;\n]"))
	      nil
	    (if (and (car indent-stack)
		     (>= (car indent-stack) 0))
		(setq this-indent (car indent-stack))
	      (let ((val (calculate-scheme-indent
			  (if (car indent-stack) (- (car indent-stack))))))
		(if (integerp val)
		    (setcar indent-stack
			    (setq this-indent val))
		  (setcar indent-stack (- (car (cdr val))))
		  (setq this-indent (car val)))))
	    (if (/= (current-column) this-indent)
		(progn (delete-region bol (point))
		       (indent-to this-indent)))))))))