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.
|
|
|
|
|
|
|
|
|
|
|#
|
|
|
|
|
|
|
|
|
|
;;;; C Indentation (from GNU Emacs)
|
|
|
|
|
|
2021-04-26 07:57:47 -04:00
|
|
|
|
|
2021-04-26 07:53:20 -04:00
|
|
|
|
|
|
|
|
|
(define-variable c-indent-level
|
|
|
|
|
"Indentation of C statements with respect to containing block."
|
|
|
|
|
2
|
|
|
|
|
exact-integer?)
|
|
|
|
|
|
|
|
|
|
(define-variable c-brace-imaginary-offset
|
|
|
|
|
"Imagined indentation of a C open brace that actually follows a statement."
|
|
|
|
|
0
|
|
|
|
|
exact-integer?)
|
|
|
|
|
|
|
|
|
|
(define-variable c-brace-offset
|
|
|
|
|
"Extra indentation for braces, compared with other text in same context."
|
|
|
|
|
0
|
|
|
|
|
exact-integer?)
|
|
|
|
|
|
|
|
|
|
(define-variable c-argdecl-indent
|
|
|
|
|
"Indentation level of declarations of C function arguments."
|
|
|
|
|
5
|
|
|
|
|
exact-integer?)
|
|
|
|
|
|
|
|
|
|
(define-variable c-label-offset
|
|
|
|
|
"Offset of C label lines and case statements relative to usual indentation."
|
|
|
|
|
-2
|
|
|
|
|
exact-integer?)
|
|
|
|
|
|
|
|
|
|
(define-variable c-continued-statement-offset
|
|
|
|
|
"Extra indent for lines not starting new statements."
|
|
|
|
|
2
|
|
|
|
|
exact-integer?)
|
|
|
|
|
|
|
|
|
|
(define-variable c-continued-brace-offset
|
|
|
|
|
"Extra indent for substatements that start with open-braces.
|
|
|
|
|
This is in addition to c-continued-statement-offset."
|
|
|
|
|
0
|
|
|
|
|
exact-integer?)
|
|
|
|
|
|
|
|
|
|
(define (c-indent-line start)
|
|
|
|
|
(let ((old-indentation (mark-indentation start))
|
|
|
|
|
(new-indentation (c-compute-indentation start)))
|
|
|
|
|
(if (not (fix:= new-indentation old-indentation))
|
|
|
|
|
(change-indentation new-indentation start))
|
|
|
|
|
(- new-indentation old-indentation)))
|
|
|
|
|
|
|
|
|
|
(define (c-compute-indentation start)
|
|
|
|
|
(let ((start (line-start start 0)))
|
|
|
|
|
(let ((indentation (calculate-indentation start #f)))
|
|
|
|
|
(if (exact-integer? indentation)
|
|
|
|
|
(if (char-match-forward #\# start)
|
|
|
|
|
0
|
|
|
|
|
(indent-line:adjust-indentation (horizontal-space-end start)
|
|
|
|
|
indentation))
|
|
|
|
|
(nonstandard-indentation start indentation)))))
|
|
|
|
|
|
|
|
|
|
(define (nonstandard-indentation start state)
|
|
|
|
|
(cond ((parse-state-in-string? state)
|
|
|
|
|
(mark-indentation start))
|
|
|
|
|
((parse-state-in-comment? state)
|
|
|
|
|
(mark-column
|
|
|
|
|
(let ((comment-start (parse-state-comment-start state)))
|
|
|
|
|
(if (and (char-match-forward #\* (indentation-end start))
|
|
|
|
|
(match-forward "/*" comment-start))
|
|
|
|
|
(mark1+ comment-start)
|
|
|
|
|
(or (re-match-forward "/\\(/+\\|\\*+\\)[ \t]*"
|
|
|
|
|
comment-start)
|
|
|
|
|
comment-start)))))
|
|
|
|
|
(else
|
|
|
|
|
(error "Illegal non-standard indentation:" state))))
|
|
|
|
|
|
|
|
|
|
(define (indent-line:adjust-indentation start indentation)
|
|
|
|
|
(cond ((or (looking-at-keyword? "case" start)
|
|
|
|
|
(and (re-match-forward "[A-Za-z]" start)
|
|
|
|
|
(char-match-forward #\: (forward-sexp start 1 'LIMIT))))
|
|
|
|
|
(max 1 (+ indentation (ref-variable c-label-offset start))))
|
|
|
|
|
((looking-at-keyword? "else" start)
|
|
|
|
|
(mark-indentation
|
|
|
|
|
(backward-to-start-of-if
|
|
|
|
|
start
|
|
|
|
|
(backward-definition-start start 1 'LIMIT))))
|
|
|
|
|
((char-match-forward #\} start)
|
|
|
|
|
(max 0 (- indentation (ref-variable c-indent-level start))))
|
|
|
|
|
((char-match-forward #\{ start)
|
|
|
|
|
(max 0 (+ indentation (ref-variable c-brace-offset start))))
|
|
|
|
|
(else (max 0 indentation))))
|
|
|
|
|
|
|
|
|
|
(define (calculate-indentation mark parse-start)
|
|
|
|
|
(let ((indent-point (line-start mark 0)))
|
|
|
|
|
(let ((state
|
|
|
|
|
(let loop
|
|
|
|
|
((start
|
|
|
|
|
(or parse-start (backward-definition-start mark 1 'LIMIT))))
|
|
|
|
|
(let ((state (parse-partial-sexp start indent-point 0)))
|
|
|
|
|
(if (mark= (parse-state-location state) indent-point)
|
|
|
|
|
state
|
|
|
|
|
(loop (parse-state-location state)))))))
|
|
|
|
|
(let ((container (parse-state-containing-sexp state)))
|
|
|
|
|
(cond ((or (parse-state-in-string? state)
|
|
|
|
|
(parse-state-in-comment? state))
|
|
|
|
|
state)
|
|
|
|
|
((not container)
|
|
|
|
|
(calculate-indentation:top-level indent-point
|
|
|
|
|
(or parse-start
|
|
|
|
|
(group-start mark))))
|
|
|
|
|
((char-match-forward #\{ container)
|
|
|
|
|
(calculate-indentation:statement indent-point container))
|
|
|
|
|
(else
|
|
|
|
|
;; Line is expression, not statement: indent to just
|
|
|
|
|
;; after the surrounding open.
|
|
|
|
|
(mark-column (mark1+ container))))))))
|
|
|
|
|
|
|
|
|
|
(define (calculate-indentation:top-level indent-point parse-start)
|
|
|
|
|
(if (or (re-match-forward "[ \t]*{" indent-point)
|
|
|
|
|
(function-start? indent-point parse-start))
|
|
|
|
|
;; This appears to be the start of a function or a function
|
|
|
|
|
;; body, so indent in the left-hand column.
|
|
|
|
|
0
|
|
|
|
|
(let ((m (backward-to-noncomment indent-point parse-start)))
|
|
|
|
|
(if (or (not m) (not (extract-left-char m)))
|
|
|
|
|
;; This appears to be the beginning of a top-level data
|
|
|
|
|
;; definition, so indent in the left-hand column.
|
|
|
|
|
0
|
|
|
|
|
;; Look at the previous left-justified line to determine
|
|
|
|
|
;; if we're in a data definition or a function preamble.
|
|
|
|
|
(let ((m (re-search-backward "^[^ \t\n\f#]" m)))
|
|
|
|
|
(if (not m)
|
|
|
|
|
0
|
|
|
|
|
(let ((m (function-start? m parse-start)))
|
|
|
|
|
(if (and m (mark< m indent-point))
|
|
|
|
|
;; Previous line is a function start and we're
|
|
|
|
|
;; indenting a line that follows the parameter
|
|
|
|
|
;; list and precedes the body, so indent it as
|
|
|
|
|
;; a parameter declaration.
|
|
|
|
|
(ref-variable c-argdecl-indent indent-point)
|
|
|
|
|
0))))))))
|
|
|
|
|
|
|
|
|
|
(define (function-start? lstart parse-start)
|
|
|
|
|
;; True iff LSTART points at the beginning of a function definition.
|
|
|
|
|
;; If true, returns a mark pointing to the end of the function's
|
|
|
|
|
;; parameter list.
|
|
|
|
|
(and (re-match-forward "\\sw\\|\\s_" lstart)
|
|
|
|
|
(re-match-forward "[^\"\n=(]*(" lstart)
|
|
|
|
|
(let ((open (mark-1+ (re-match-end 0))))
|
|
|
|
|
;; OPEN looks like the start of a parameter list. If it
|
|
|
|
|
;; doesn't end in comma or semicolon, and furthermore isn't
|
|
|
|
|
;; in a comment, we conclude that it is a parameter list, and
|
|
|
|
|
;; consequently that we're looking at a function.
|
|
|
|
|
(and (not (parse-state-in-comment?
|
|
|
|
|
(parse-partial-sexp parse-start open)))
|
|
|
|
|
(let ((m (forward-sexp open 1)))
|
|
|
|
|
(and m
|
|
|
|
|
(let ((m (skip-chars-forward " \t\f" m)))
|
|
|
|
|
(and (not (re-match-forward "[,;]" m))
|
|
|
|
|
m))))))))
|
|
|
|
|
|
|
|
|
|
(define (calculate-indentation:statement indent-point container)
|
|
|
|
|
(let ((mark
|
|
|
|
|
(let loop ((start indent-point))
|
|
|
|
|
(let ((m (backward-to-noncomment start container)))
|
|
|
|
|
;; Back up over label lines, since they don't affect
|
|
|
|
|
;; whether our line is a continuation.
|
|
|
|
|
(case (and m (mark> m container) (extract-left-char m))
|
|
|
|
|
((#\:)
|
|
|
|
|
(if (let ((m (backward-to-noncomment (mark-1+ m) container)))
|
|
|
|
|
(and m
|
|
|
|
|
(mark> m container)
|
|
|
|
|
(re-match-forward "'\\|\\sw\\|\\s_" (mark-1+ m))))
|
|
|
|
|
(loop (line-start m 0))
|
|
|
|
|
m))
|
|
|
|
|
((#\,)
|
|
|
|
|
(let ((ls (line-start m 0)))
|
|
|
|
|
(if (mark<= ls container)
|
|
|
|
|
#f
|
|
|
|
|
(loop (horizontal-space-end ls)))))
|
|
|
|
|
(else m))))))
|
|
|
|
|
(if (and mark (not (memv (extract-left-char mark) '(#F #\, #\; #\{ #\}))))
|
|
|
|
|
;; This line is continuation of preceding line's statement;
|
|
|
|
|
;; indent c-continued-statement-offset more than the previous
|
|
|
|
|
;; line of the statement.
|
|
|
|
|
(+ (ref-variable c-continued-statement-offset indent-point)
|
|
|
|
|
(mark-column (backward-to-start-of-continued-exp mark container))
|
|
|
|
|
(if (re-match-forward "[ \t]*{" indent-point)
|
|
|
|
|
(ref-variable c-continued-brace-offset indent-point)
|
|
|
|
|
0))
|
|
|
|
|
(or (skip-comments&labels (mark1+ container) indent-point)
|
|
|
|
|
;; If no previous statement, indent it relative to line
|
|
|
|
|
;; brace is on. For open brace in column zero, don't let
|
|
|
|
|
;; statement start there too. If c-indent-level is zero,
|
|
|
|
|
;; use c-brace-offset + c-continued-statement-offset
|
|
|
|
|
;; instead. For open-braces not the first thing in a
|
|
|
|
|
;; line, add in c-brace-imaginary-offset.
|
|
|
|
|
(+ (if (and (line-start? container)
|
|
|
|
|
(= 0 (ref-variable c-indent-level indent-point)))
|
|
|
|
|
(+ (ref-variable c-brace-offset indent-point)
|
|
|
|
|
(ref-variable c-continued-statement-offset indent-point))
|
|
|
|
|
(ref-variable c-indent-level indent-point))
|
|
|
|
|
(let ((container (skip-chars-backward " \t" container)))
|
|
|
|
|
;; If open brace is not the first non-white thing on
|
|
|
|
|
;; the line, add the c-brace-imaginary-offset.
|
|
|
|
|
(+ (if (line-start? container)
|
|
|
|
|
0
|
|
|
|
|
(ref-variable c-brace-imaginary-offset indent-point))
|
|
|
|
|
(mark-indentation
|
|
|
|
|
;; If the open brace is preceded by a
|
|
|
|
|
;; parenthesized expression, move to the
|
|
|
|
|
;; beginning of that; possibly a different line.
|
|
|
|
|
(if (eqv? #\) (extract-left-char container))
|
|
|
|
|
(backward-sexp container 1 'LIMIT)
|
|
|
|
|
container)))))))))
|
|
|
|
|
|
|
|
|
|
(define (skip-comments&labels start end)
|
|
|
|
|
(let ((gend (group-end start)))
|
|
|
|
|
(let loop ((mark start) (colon-line-end false))
|
|
|
|
|
(let ((mark (whitespace-end mark gend)))
|
|
|
|
|
(cond ((mark>= mark end)
|
|
|
|
|
false)
|
|
|
|
|
((or (char-match-forward #\# mark)
|
|
|
|
|
(match-forward "//" mark))
|
|
|
|
|
(loop (line-start mark 1 'LIMIT) colon-line-end))
|
|
|
|
|
((match-forward "/*" mark)
|
|
|
|
|
(loop (or (search-forward "*/" mark gend) gend) colon-line-end))
|
|
|
|
|
((re-match-forward "case[ \t\n].*:\\|[a-zA-Z0-9_$]*[ \t\n]*:"
|
|
|
|
|
mark gend false)
|
|
|
|
|
(loop (re-match-end 0) (line-end mark 0)))
|
|
|
|
|
((and colon-line-end (mark> colon-line-end mark))
|
|
|
|
|
(- (mark-indentation mark)
|
|
|
|
|
(ref-variable c-label-offset mark)))
|
|
|
|
|
(else
|
|
|
|
|
(mark-column mark)))))))
|
|
|
|
|
|
|
|
|
|
(define (c-indent-expression expression-start)
|
|
|
|
|
(let ((end
|
|
|
|
|
(mark-left-inserting-copy
|
|
|
|
|
(line-start (forward-sexp expression-start 1 'ERROR) 0))))
|
|
|
|
|
(if (mark< expression-start end)
|
|
|
|
|
(let loop
|
|
|
|
|
((start expression-start)
|
|
|
|
|
(state false)
|
|
|
|
|
(indent-stack (list false))
|
|
|
|
|
(contain-stack (list expression-start))
|
|
|
|
|
(last-depth 0))
|
|
|
|
|
(call-with-values
|
|
|
|
|
(lambda () (c-indent-expression:parse-line start end state))
|
|
|
|
|
(lambda (start state)
|
|
|
|
|
(let* ((depth (parse-state-depth state))
|
|
|
|
|
(depth-delta (- depth last-depth))
|
|
|
|
|
(indent-stack (adjust-stack depth-delta indent-stack))
|
|
|
|
|
(contain-stack (adjust-stack depth-delta contain-stack))
|
|
|
|
|
(indent-line
|
|
|
|
|
(lambda ()
|
|
|
|
|
(if (not (line-blank? start))
|
|
|
|
|
(c-indent-expression:per-line
|
|
|
|
|
(skip-chars-forward " \t" start)
|
|
|
|
|
expression-start
|
|
|
|
|
indent-stack
|
|
|
|
|
contain-stack)))))
|
|
|
|
|
(if (not (car contain-stack))
|
|
|
|
|
(set-car! contain-stack
|
|
|
|
|
(or (parse-state-containing-sexp state)
|
|
|
|
|
(backward-sexp start 1 'LIMIT))))
|
|
|
|
|
(if (mark= start end)
|
|
|
|
|
(begin
|
|
|
|
|
(mark-temporary! end)
|
|
|
|
|
(indent-line))
|
|
|
|
|
(begin
|
|
|
|
|
(indent-line)
|
|
|
|
|
(loop start state indent-stack contain-stack
|
|
|
|
|
depth))))))))))
|
|
|
|
|
|
|
|
|
|
(define (c-indent-expression:parse-line start end state)
|
|
|
|
|
(let loop ((start start) (state state))
|
|
|
|
|
(if (and state (parse-state-in-comment? state))
|
|
|
|
|
(c-indent-line start))
|
|
|
|
|
(let ((start* (line-start start 1)))
|
|
|
|
|
(let ((state* (parse-partial-sexp start start* false false state)))
|
|
|
|
|
(cond ((mark= start* end)
|
|
|
|
|
(values start* state*))
|
|
|
|
|
((parse-state-in-comment? state*)
|
|
|
|
|
(if (not (and state (parse-state-in-comment? state)))
|
|
|
|
|
(c-comment-indent (parse-state-comment-start state*)))
|
|
|
|
|
(loop start* state*))
|
|
|
|
|
((parse-state-in-string? state*)
|
|
|
|
|
(loop start* state*))
|
|
|
|
|
(else
|
|
|
|
|
(values start* state*)))))))
|
|
|
|
|
|
|
|
|
|
(define (c-indent-expression:per-line start expression-start
|
|
|
|
|
indent-stack contain-stack)
|
|
|
|
|
(let ((indentation
|
|
|
|
|
(indent-line:adjust-indentation
|
|
|
|
|
start
|
|
|
|
|
(cond ((not (car indent-stack))
|
|
|
|
|
(let ((indentation
|
|
|
|
|
(let ((indentation (calculate-indentation start #f)))
|
|
|
|
|
(if (exact-integer? indentation)
|
|
|
|
|
indentation
|
|
|
|
|
(nonstandard-indentation start indentation)))))
|
|
|
|
|
(set-car! indent-stack indentation)
|
|
|
|
|
indentation))
|
|
|
|
|
((not (char-match-forward #\{ (car contain-stack)))
|
|
|
|
|
(car indent-stack))
|
|
|
|
|
(else
|
|
|
|
|
;; Line is at statement level. Is it a new
|
|
|
|
|
;; statement? Is it an else? Find last non-comment
|
|
|
|
|
;; character before this line.
|
|
|
|
|
(let ((mark (backward-to-noncomment start expression-start)))
|
|
|
|
|
(cond ((not (memv (extract-left-char mark)
|
|
|
|
|
'(#F #\, #\; #\} #\: #\{)))
|
|
|
|
|
(+ (ref-variable c-continued-statement-offset mark)
|
|
|
|
|
(mark-column
|
|
|
|
|
(backward-to-start-of-continued-exp
|
|
|
|
|
mark
|
|
|
|
|
(car contain-stack)))
|
|
|
|
|
(if (char-match-forward #\{ start)
|
|
|
|
|
(ref-variable c-continued-brace-offset mark)
|
|
|
|
|
0)))
|
|
|
|
|
((looking-at-keyword? "else" start)
|
|
|
|
|
(mark-indentation
|
|
|
|
|
(backward-to-start-of-if mark expression-start)))
|
|
|
|
|
(else
|
|
|
|
|
(car indent-stack)))))))))
|
|
|
|
|
(if (not (char-match-forward #\# start))
|
|
|
|
|
(maybe-change-indentation indentation start))))
|
|
|
|
|
|
|
|
|
|
(define (whitespace-start start end)
|
|
|
|
|
(skip-chars-backward " \t\n" start end))
|
|
|
|
|
|
|
|
|
|
(define (whitespace-end start end)
|
|
|
|
|
(skip-chars-forward " \t\n" start end))
|
|
|
|
|
|
|
|
|
|
(define (looking-at-keyword? keyword start)
|
|
|
|
|
(let ((end (line-end start 0)))
|
|
|
|
|
(and (re-match-forward (string-append keyword "\\b") start end false)
|
|
|
|
|
(not (re-match-forward (string-append keyword "\\s_") start end
|
|
|
|
|
false)))))
|
|
|
|
|
|
|
|
|
|
(define (backward-to-noncomment start end)
|
|
|
|
|
(let loop ((start start))
|
|
|
|
|
(let ((mark
|
|
|
|
|
(let ((mark (whitespace-start start end)))
|
|
|
|
|
(or (match-backward "*/" mark)
|
|
|
|
|
mark))))
|
|
|
|
|
(let ((state (parse-partial-sexp end mark)))
|
|
|
|
|
(if (parse-state-in-comment? state)
|
|
|
|
|
(loop (parse-state-comment-start state))
|
|
|
|
|
(let ((mark* (indentation-end mark)))
|
|
|
|
|
(cond ((not (char-match-forward #\# mark*)) mark)
|
|
|
|
|
((mark<= mark* end) mark*)
|
|
|
|
|
(else (loop mark*)))))))))
|
|
|
|
|
|
|
|
|
|
(define (backward-to-start-of-continued-exp start end)
|
|
|
|
|
(let ((mark
|
|
|
|
|
(line-start (if (char-match-backward #\) start)
|
|
|
|
|
(backward-sexp start 1 'LIMIT)
|
|
|
|
|
start)
|
|
|
|
|
0)))
|
|
|
|
|
(horizontal-space-end (if (mark<= mark end) (mark1+ end) mark))))
|
|
|
|
|
|
|
|
|
|
(define (backward-to-start-of-if start end)
|
|
|
|
|
(let loop ((mark start) (if-level 1))
|
|
|
|
|
(let ((mark (backward-sexp mark 1 'LIMIT)))
|
|
|
|
|
(let ((adjust-level
|
|
|
|
|
(lambda (if-level)
|
|
|
|
|
(if (= if-level 0)
|
|
|
|
|
mark
|
|
|
|
|
(loop mark if-level)))))
|
|
|
|
|
(cond ((looking-at-keyword? "else" mark)
|
|
|
|
|
(adjust-level (+ if-level 1)))
|
|
|
|
|
((looking-at-keyword? "if" mark)
|
|
|
|
|
(adjust-level (- if-level 1)))
|
|
|
|
|
((mark>= mark end)
|
|
|
|
|
(adjust-level if-level))
|
|
|
|
|
(else
|
|
|
|
|
end))))))
|
|
|
|
|
|
|
|
|
|
(define (adjust-stack depth-delta stack)
|
|
|
|
|
(cond ((= depth-delta 0)
|
|
|
|
|
stack)
|
|
|
|
|
((> depth-delta 0)
|
|
|
|
|
(let loop ((depth-delta depth-delta) (stack stack))
|
|
|
|
|
(if (= 1 depth-delta)
|
|
|
|
|
(cons false stack)
|
|
|
|
|
(loop (- depth-delta 1) (cons false stack)))))
|
|
|
|
|
(else
|
|
|
|
|
(let loop ((depth-delta depth-delta) (stack stack))
|
|
|
|
|
(if (= -1 depth-delta)
|
|
|
|
|
(cdr stack)
|
2021-04-26 07:57:47 -04:00
|
|
|
|
(loop (+ depth-delta 1) (cdr stack)))))))
|