2021-04-26 07:53:20 -04:00
|
|
|
|
#| -*-Scheme-*-
|
|
|
|
|
|
|
|
|
|
Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
|
|
|
|
|
1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
|
|
|
|
|
2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
|
|
|
|
|
2017, 2018, 2019, 2020 Massachusetts Institute of Technology
|
|
|
|
|
|
|
|
|
|
This file is part of MIT/GNU Scheme.
|
|
|
|
|
|
|
|
|
|
MIT/GNU Scheme is free software; you can redistribute it and/or modify
|
|
|
|
|
it under the terms of the GNU General Public License as published by
|
|
|
|
|
the Free Software Foundation; either version 2 of the License, or (at
|
|
|
|
|
your option) any later version.
|
|
|
|
|
|
|
|
|
|
MIT/GNU Scheme is distributed in the hope that it will be useful, but
|
|
|
|
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
|
|
General Public License for more details.
|
|
|
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
|
|
|
along with MIT/GNU Scheme; if not, write to the Free Software
|
|
|
|
|
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
|
|
|
|
|
USA.
|
|
|
|
|
|
|
|
|
|
|#
|
|
|
|
|
|
|
|
|
|
;;;; Lisp Indentation
|
|
|
|
|
|
2021-04-26 07:57:47 -04:00
|
|
|
|
|
2021-04-26 07:53:20 -04:00
|
|
|
|
|
|
|
|
|
(define-variable lisp-indent-offset
|
|
|
|
|
"If not false, the number of extra columns to indent a subform."
|
|
|
|
|
#f
|
|
|
|
|
(lambda (object) (or (not object) (exact-integer? object))))
|
|
|
|
|
|
|
|
|
|
(define-variable lisp-indent-hook
|
|
|
|
|
"If not false, a procedure for modifying lisp indentation."
|
|
|
|
|
#f
|
|
|
|
|
(lambda (object) (or (not object) (procedure? object))))
|
|
|
|
|
|
|
|
|
|
(define-variable lisp-indent-methods
|
|
|
|
|
"String table identifying special forms for lisp indentation."
|
|
|
|
|
#f
|
|
|
|
|
(lambda (object) (or (not object) (string-table? object))))
|
|
|
|
|
|
|
|
|
|
(define-variable lisp-indent-regexps
|
|
|
|
|
"Association list specifying (REGEXP . METHOD) indentation pairs.
|
|
|
|
|
The first element of the list is a symbol.
|
|
|
|
|
The remaining elements of the list are the indentation pairs.
|
|
|
|
|
Each REGEXP is matched against the keyword of the form being indented.
|
|
|
|
|
If a match is found, the METHOD associated with the first matching REGEXP
|
|
|
|
|
is used to calculate the indentation for that form."
|
|
|
|
|
'(LISP-INDENT-REGEXPS)
|
|
|
|
|
(lambda (object)
|
|
|
|
|
(and (pair? object)
|
|
|
|
|
(symbol? (car object))
|
|
|
|
|
(alist? (cdr object))
|
|
|
|
|
(every (lambda (entry) (string? (car entry))) (cdr object)))))
|
|
|
|
|
|
|
|
|
|
(define-variable lisp-body-indent
|
|
|
|
|
"Number of extra columns to indent the body of a special form."
|
|
|
|
|
2
|
|
|
|
|
exact-nonnegative-integer?)
|
|
|
|
|
|
|
|
|
|
;;; CALCULATE-LISP-INDENTATION returns either an integer, which is the
|
|
|
|
|
;;; column to indent to, or a pair. In the latter case this means
|
|
|
|
|
;;; that subsequent forms in the same expression may not be indented
|
|
|
|
|
;;; the same way; so the car is the indentation, and the cdr is a mark
|
|
|
|
|
;;; pointing at the beginning of the containing expression. Typically
|
|
|
|
|
;;; this is passed back in as PARSE-START to speed up the indentation
|
|
|
|
|
;;; of many forms at once.
|
|
|
|
|
|
|
|
|
|
(define (calculate-lisp-indentation mark #!optional parse-start)
|
|
|
|
|
(find-outer-container (if (default-object? parse-start)
|
|
|
|
|
(or (backward-one-definition-start mark)
|
|
|
|
|
(group-start mark))
|
|
|
|
|
parse-start)
|
|
|
|
|
(line-start mark 0)))
|
|
|
|
|
|
|
|
|
|
(define (find-outer-container start indent-point)
|
|
|
|
|
(let ((state (parse-partial-sexp start indent-point 0)))
|
|
|
|
|
(if (mark= (parse-state-location state) indent-point)
|
|
|
|
|
(find-inner-container state false false indent-point)
|
|
|
|
|
(find-outer-container (parse-state-location state) indent-point))))
|
|
|
|
|
|
|
|
|
|
(define (find-inner-container state container last-sexp indent-point)
|
|
|
|
|
(if (<= (parse-state-depth state) 0)
|
|
|
|
|
(simple-indent state container last-sexp indent-point)
|
|
|
|
|
(let ((container (parse-state-containing-sexp state))
|
|
|
|
|
(last-sexp (parse-state-last-sexp state)))
|
|
|
|
|
(let ((after-opener (mark1+ container)))
|
|
|
|
|
(if (and last-sexp (mark> last-sexp after-opener))
|
|
|
|
|
(let ((peek (parse-partial-sexp last-sexp indent-point 0)))
|
|
|
|
|
(if (not (parse-state-containing-sexp peek))
|
|
|
|
|
(simple-indent state container last-sexp indent-point)
|
|
|
|
|
(find-inner-container peek container last-sexp
|
|
|
|
|
indent-point)))
|
|
|
|
|
(simple-indent state container last-sexp indent-point))))))
|
|
|
|
|
|
|
|
|
|
(define (simple-indent state container last-sexp indent-point)
|
|
|
|
|
(cond ((parse-state-in-string? state)
|
|
|
|
|
(mark-column (horizontal-space-end indent-point)))
|
|
|
|
|
((and (integer? (ref-variable lisp-indent-offset indent-point))
|
|
|
|
|
container)
|
|
|
|
|
(+ (ref-variable lisp-indent-offset indent-point)
|
|
|
|
|
(mark-column container)))
|
|
|
|
|
((positive? (parse-state-depth state))
|
|
|
|
|
(if (not last-sexp)
|
|
|
|
|
(mark-column (mark1+ container))
|
|
|
|
|
(normal-indent state container last-sexp indent-point)))
|
|
|
|
|
(else
|
|
|
|
|
(mark-column (parse-state-location state)))))
|
|
|
|
|
|
|
|
|
|
;;; The following are true when the indent hook is called:
|
|
|
|
|
;;;
|
|
|
|
|
;;; * CONTAINER < NORMAL-INDENT <= LAST-SEXP < INDENT-POINT
|
|
|
|
|
;;; * Since INDENT-POINT is a line start, LAST-SEXP is on a
|
|
|
|
|
;;; line previous to that line.
|
|
|
|
|
;;; * NORMAL-INDENT is at the start of an expression.
|
|
|
|
|
|
|
|
|
|
(define (normal-indent state container last-sexp indent-point)
|
|
|
|
|
(let ((first-sexp (forward-to-sexp-start (mark1+ container) last-sexp)))
|
|
|
|
|
(let ((normal-indent
|
|
|
|
|
(if (mark> (line-end container 0) last-sexp)
|
|
|
|
|
;; CONTAINER and LAST-SEXP are on same line.
|
|
|
|
|
;; If FIRST-SEXP = LAST-SEXP, indent under that, else
|
|
|
|
|
;; indent under the second expression on that line.
|
|
|
|
|
(if (mark= first-sexp last-sexp)
|
|
|
|
|
last-sexp
|
|
|
|
|
(forward-to-sexp-start (forward-one-sexp first-sexp)
|
|
|
|
|
last-sexp))
|
|
|
|
|
;; LAST-SEXP is on subsequent line -- indent under the
|
|
|
|
|
;; first expression on that line.
|
|
|
|
|
(forward-to-sexp-start (line-start last-sexp 0) last-sexp))))
|
|
|
|
|
(if (char=? #\(
|
|
|
|
|
(char->syntax-code (ref-variable syntax-table indent-point)
|
|
|
|
|
(mark-right-char first-sexp)))
|
|
|
|
|
;; The first expression is a list -- don't bother to call
|
|
|
|
|
;; the indent hook.
|
|
|
|
|
(mark-column (backward-prefix-chars normal-indent))
|
|
|
|
|
(let ((normal-indent (backward-prefix-chars normal-indent)))
|
|
|
|
|
(or (let ((hook (ref-variable lisp-indent-hook indent-point)))
|
|
|
|
|
(and hook
|
|
|
|
|
(hook state indent-point normal-indent)))
|
|
|
|
|
(mark-column normal-indent)))))))
|
|
|
|
|
|
|
|
|
|
;;;; Indent Hook
|
|
|
|
|
|
|
|
|
|
;;; Look at the first expression in the containing expression, and if
|
|
|
|
|
;;; it is an atom, look it up in the Lisp Indent Methods table. Three
|
|
|
|
|
;;; types of entry are recognized:
|
|
|
|
|
;;;
|
|
|
|
|
;;; 'DEFINITION means treat this form as a definition.
|
|
|
|
|
;;; <n> means treat this form as a special form.
|
|
|
|
|
;;; Otherwise, the entry must be a procedure, which is called.
|
|
|
|
|
|
|
|
|
|
(define (standard-lisp-indent-hook state indent-point normal-indent)
|
|
|
|
|
(let ((first-sexp
|
|
|
|
|
(forward-to-sexp-start (mark1+ (parse-state-containing-sexp state))
|
|
|
|
|
indent-point)))
|
|
|
|
|
(and (let ((syntax
|
|
|
|
|
(char->syntax-code (ref-variable syntax-table indent-point)
|
|
|
|
|
(mark-right-char first-sexp))))
|
|
|
|
|
(or (char=? #\w syntax)
|
|
|
|
|
(char=? #\_ syntax)))
|
|
|
|
|
(let ((end (forward-one-sexp first-sexp)))
|
|
|
|
|
(let ((method (find-indent-method first-sexp end)))
|
|
|
|
|
(cond ((eq? method 'DEFINITION)
|
|
|
|
|
(lisp-indent-definition state indent-point normal-indent))
|
|
|
|
|
((exact-integer? method)
|
|
|
|
|
(lisp-indent-special-form method state indent-point
|
|
|
|
|
normal-indent))
|
|
|
|
|
((procedure-of-arity? method 3)
|
|
|
|
|
(method state indent-point normal-indent))
|
|
|
|
|
(else #f)))))))
|
|
|
|
|
|
|
|
|
|
(define (find-indent-method start end)
|
|
|
|
|
(let ((name (extract-string start end)))
|
|
|
|
|
(or (let ((v (name->variable (symbol 'LISP-INDENT/ name) #f)))
|
|
|
|
|
(and v
|
|
|
|
|
(variable-local-value start v)))
|
|
|
|
|
(let ((methods (ref-variable lisp-indent-methods start)))
|
|
|
|
|
(and methods
|
|
|
|
|
(string-table-get methods name)))
|
|
|
|
|
(let loop ((alist (cdr (ref-variable lisp-indent-regexps start))))
|
|
|
|
|
(and (pair? alist)
|
|
|
|
|
(if (re-match-forward (caar alist) start end #t)
|
|
|
|
|
(cdar alist)
|
|
|
|
|
(loop (cdr alist))))))))
|
|
|
|
|
|
|
|
|
|
;;; Indent the first subform in a definition at the body indent.
|
|
|
|
|
;;; Indent subsequent subforms normally.
|
|
|
|
|
|
|
|
|
|
(define (lisp-indent-definition state indent-point normal-indent)
|
|
|
|
|
normal-indent ;ignore
|
|
|
|
|
(let ((container (parse-state-containing-sexp state)))
|
|
|
|
|
(and (mark> (line-end container 0) (parse-state-last-sexp state))
|
|
|
|
|
(+ (ref-variable lisp-body-indent indent-point)
|
|
|
|
|
(mark-column container)))))
|
|
|
|
|
|
|
|
|
|
;;; Indent the first N subforms normally, but then indent the
|
|
|
|
|
;;; remaining forms at the body-indent. If this is one of the first
|
|
|
|
|
;;; N, a cons is returned, the cdr of which is CONTAINING-SEXP. This
|
|
|
|
|
;;; is to speed up indentation of successive forms.
|
|
|
|
|
|
|
|
|
|
(define (lisp-indent-special-form n state indent-point normal-indent)
|
|
|
|
|
(if (negative? n) (error "Special form indent hook negative" n))
|
|
|
|
|
(let ((container (parse-state-containing-sexp state)))
|
|
|
|
|
(let ((body-indent
|
|
|
|
|
(+ (mark-column container)
|
|
|
|
|
(ref-variable lisp-body-indent indent-point)))
|
|
|
|
|
(normal-indent (mark-column normal-indent)))
|
|
|
|
|
(let loop ((count n) (mark (mark1+ container)))
|
|
|
|
|
(let ((mark
|
|
|
|
|
(let ((mark (forward-one-sexp mark indent-point)))
|
|
|
|
|
(and mark
|
|
|
|
|
(forward-to-sexp-start mark indent-point)))))
|
|
|
|
|
(cond ((and mark (mark< mark indent-point))
|
|
|
|
|
(loop (-1+ count) mark))
|
|
|
|
|
((positive? count)
|
|
|
|
|
(cons (+ body-indent
|
|
|
|
|
(ref-variable lisp-body-indent indent-point))
|
|
|
|
|
(mark-permanent! container)))
|
|
|
|
|
((and (zero? count)
|
|
|
|
|
(or (zero? n)
|
|
|
|
|
(<= body-indent normal-indent)))
|
|
|
|
|
body-indent)
|
|
|
|
|
(else normal-indent)))))))
|
|
|
|
|
|
|
|
|
|
;;;; Indent Line
|
|
|
|
|
|
|
|
|
|
(define (lisp-indent-line whole-sexp?)
|
|
|
|
|
(let ((start (indentation-end (current-point))))
|
|
|
|
|
(if (not (match-forward ";;;" start))
|
|
|
|
|
(let ((indentation
|
|
|
|
|
(let ((indent (calculate-lisp-indentation start)))
|
|
|
|
|
(if (pair? indent)
|
|
|
|
|
(car indent)
|
|
|
|
|
indent))))
|
|
|
|
|
(let ((shift-amount (- indentation (mark-column start))))
|
|
|
|
|
(cond ((not (zero? shift-amount))
|
|
|
|
|
(if whole-sexp?
|
|
|
|
|
(mark-permanent! start))
|
|
|
|
|
(change-indentation indentation start)
|
|
|
|
|
(if whole-sexp?
|
|
|
|
|
(indent-code-rigidly start
|
|
|
|
|
(forward-sexp start 1 'ERROR)
|
|
|
|
|
shift-amount
|
|
|
|
|
false)))
|
|
|
|
|
((within-indentation? (current-point))
|
|
|
|
|
(set-current-point! start))))))))
|
|
|
|
|
|
|
|
|
|
(define (indent-code-rigidly start end shift-amount nochange-regexp)
|
|
|
|
|
(let ((end (mark-left-inserting end)))
|
|
|
|
|
(let loop ((start start) (state false))
|
|
|
|
|
(let ((start* (line-start start 1 'LIMIT)))
|
|
|
|
|
(if (mark< start* end)
|
|
|
|
|
(let ((start start*)
|
|
|
|
|
(state (parse-partial-sexp start start* false false state)))
|
|
|
|
|
(if (not (or (parse-state-in-string? state)
|
|
|
|
|
(parse-state-in-comment? state)
|
|
|
|
|
(and nochange-regexp
|
|
|
|
|
(re-match-forward nochange-regexp start))))
|
|
|
|
|
(let ((start (horizontal-space-end start)))
|
|
|
|
|
(cond ((line-end? start)
|
|
|
|
|
(delete-horizontal-space start))
|
|
|
|
|
((not (match-forward ";;;" start))
|
|
|
|
|
(change-indentation (max 0
|
|
|
|
|
(+ (mark-column start)
|
|
|
|
|
shift-amount))
|
|
|
|
|
start)))))
|
|
|
|
|
(loop start state)))))))
|
|
|
|
|
|
|
|
|
|
;;;; Indent Comment
|
|
|
|
|
|
|
|
|
|
(define (lisp-comment-locate mark)
|
|
|
|
|
(and (re-search-forward "\\(#;\\|;+\\)[ \t]*" mark (line-end mark 0))
|
|
|
|
|
(cons (re-match-start 0) (re-match-end 0))))
|
|
|
|
|
|
|
|
|
|
(define (lisp-comment-indentation mark #!optional stack)
|
|
|
|
|
(let ((column
|
|
|
|
|
(cond ((match-forward ";;;" mark)
|
|
|
|
|
0)
|
|
|
|
|
((or (match-forward ";;" mark)
|
|
|
|
|
(match-forward "#;" mark))
|
|
|
|
|
(compute-indentation mark
|
|
|
|
|
(if (default-object? stack) '() stack)))
|
|
|
|
|
(else
|
|
|
|
|
(ref-variable comment-column mark)))))
|
|
|
|
|
(if (within-indentation? mark)
|
|
|
|
|
column
|
|
|
|
|
(max (+ 1 (mark-column (horizontal-space-start mark)))
|
|
|
|
|
column))))
|
|
|
|
|
|
|
|
|
|
;;;; Indent Expression
|
|
|
|
|
|
|
|
|
|
(define (lisp-indent-sexp point)
|
|
|
|
|
(let ((end (mark-permanent! (line-start (forward-sexp point 1 'ERROR) 0))))
|
|
|
|
|
(if (mark< point end)
|
|
|
|
|
(let loop ((index point) (stack '()))
|
|
|
|
|
(let next-line-start ((index index) (state false))
|
|
|
|
|
(let ((start (mark-right-inserting-copy (line-start index 1))))
|
|
|
|
|
(let ((state (parse-partial-sexp index start false false state)))
|
|
|
|
|
(let ((stack (adjust-stack (parse-state-depth state) stack)))
|
|
|
|
|
(cond ((mark= start end)
|
|
|
|
|
(if (not (or (parse-state-in-string? state)
|
|
|
|
|
(parse-state-in-comment? state)))
|
|
|
|
|
(indent-expression-line start stack state))
|
|
|
|
|
(mark-temporary! start))
|
|
|
|
|
((or (parse-state-in-string? state)
|
|
|
|
|
(parse-state-in-comment? state))
|
|
|
|
|
(mark-temporary! start)
|
|
|
|
|
(next-line-start start state))
|
|
|
|
|
(else
|
|
|
|
|
(if (line-blank? start)
|
|
|
|
|
(delete-horizontal-space start)
|
|
|
|
|
(indent-expression-line start stack state))
|
|
|
|
|
(mark-temporary! start)
|
|
|
|
|
(loop start stack)))))))))))
|
|
|
|
|
|
|
|
|
|
(define (indent-expression-line start stack state)
|
|
|
|
|
(maybe-change-indentation (compute-indentation start stack) start)
|
|
|
|
|
(let ((state (parse-partial-sexp start (line-end start 0) #f #f state)))
|
|
|
|
|
(if (parse-state-in-comment? state)
|
|
|
|
|
(let ((comment-start (parse-state-comment-start state)))
|
|
|
|
|
(if (match-forward ";" comment-start)
|
|
|
|
|
(maybe-change-column (lisp-comment-indentation comment-start
|
|
|
|
|
stack)
|
|
|
|
|
comment-start))))))
|
|
|
|
|
|
|
|
|
|
(define (compute-indentation start stack)
|
|
|
|
|
(cond ((not (pair? stack))
|
|
|
|
|
(let ((indent (calculate-lisp-indentation start)))
|
|
|
|
|
(if (pair? indent)
|
|
|
|
|
(car indent)
|
|
|
|
|
indent)))
|
|
|
|
|
((and (car stack)
|
|
|
|
|
(integer? (car stack)))
|
|
|
|
|
(car stack))
|
|
|
|
|
(else
|
|
|
|
|
(let ((indent
|
|
|
|
|
(calculate-lisp-indentation
|
|
|
|
|
start
|
|
|
|
|
(or (car stack)
|
|
|
|
|
(backward-one-definition-start start)
|
|
|
|
|
(group-start start)))))
|
|
|
|
|
(if (pair? indent)
|
|
|
|
|
(begin
|
|
|
|
|
(set-car! stack (cdr indent))
|
|
|
|
|
(car indent))
|
|
|
|
|
(begin
|
|
|
|
|
(set-car! stack indent)
|
|
|
|
|
indent))))))
|
|
|
|
|
|
|
|
|
|
(define (adjust-stack depth-delta stack)
|
|
|
|
|
(cond ((zero? depth-delta) stack)
|
|
|
|
|
((positive? depth-delta) (up-stack depth-delta stack))
|
|
|
|
|
(else (down-stack depth-delta stack))))
|
|
|
|
|
|
|
|
|
|
(define (down-stack n stack)
|
|
|
|
|
(if (= -1 n) (cdr stack) (down-stack (1+ n) (cdr stack))))
|
|
|
|
|
|
|
|
|
|
(define (up-stack n stack)
|
2021-04-26 07:57:47 -04:00
|
|
|
|
(if (= 1 n) (cons false stack) (up-stack (-1+ n) (cons false stack))))
|