* progmodes/scheme.el (would-be-symbol, next-sexp-as-string):
[bpt/emacs.git] / lisp / progmodes / scheme.el
CommitLineData
d5031a2a 1;;; scheme.el --- Scheme (and DSSSL) editing mode -*- lexical-binding: t; -*-
c88ab9ce 2
ba318903 3;; Copyright (C) 1986-1988, 1997-1998, 2001-2014 Free Software
ab422c4d 4;; Foundation, Inc.
3a801d0c 5
4228277d 6;; Author: Bill Rozas <jinx@martigny.ai.mit.edu>
d575e99d 7;; Adapted-by: Dave Love <d.love@dl.ac.uk>
d7b4d18f 8;; Keywords: languages, lisp
e5167999 9
ac5b21ac
RS
10;; This file is part of GNU Emacs.
11
b1fc2b50 12;; GNU Emacs is free software: you can redistribute it and/or modify
ac5b21ac 13;; it under the terms of the GNU General Public License as published by
b1fc2b50
GM
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
ac5b21ac
RS
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
b1fc2b50 23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
ac5b21ac 24
e5167999 25;;; Commentary:
ac5b21ac 26
1367ff3a
RS
27;; The major mode for editing Scheme-type Lisp code, very similar to
28;; the Lisp mode documented in the Emacs manual. `dsssl-mode' is a
29;; variant of scheme-mode for editing DSSSL specifications for SGML
30;; documents. [As of Apr 1997, some pointers for DSSSL may be found,
31;; for instance, at <URL:http://www.sil.org/sgml/related.html#dsssl>.]
32;; All these Lisp-ish modes vary basically in details of the language
33;; syntax they highlight/indent/index, but dsssl-mode uses "^;;;" as
64ef5f39 34;; the page-delimiter since ^L isn't normally a valid SGML character.
1367ff3a
RS
35;;
36;; For interacting with a Scheme interpreter See also `run-scheme' in
37;; the `cmuscheme' package and also the implementation-specific
38;; `xscheme' package.
ac5b21ac 39
2b20743d
DL
40;; Here's a recipe to generate a TAGS file for DSSSL, by the way:
41;; etags --lang=scheme --regex='/[ \t]*(\(mode\|element\)[ \t
42;; ]+\([^ \t(
43;; ]+\)/\2/' --regex='/[ \t]*(element[ \t
44;; ]*([^)]+[ \t
45;; ]+\([^)]+\)[ \t
46;; ]*)/\1/' --regex='/(declare[^ \t
47;; ]*[ \t
48;; ]+\([^ \t
49;; ]+\)/\1/' "$@"
50
e5167999 51;;; Code:
ac5b21ac 52\f
1367ff3a
RS
53(require 'lisp-mode)
54
9fce950d
SM
55(defvar scheme-mode-syntax-table
56 (let ((st (make-syntax-table))
57 (i 0))
f13f86fb
CY
58 ;; Symbol constituents
59 ;; We used to treat chars 128-256 as symbol-constituent, but they
60 ;; should be valid word constituents (Bug#8843). Note that valid
61 ;; identifier characters are Scheme-implementation dependent.
62 (while (< i ?0)
c676c4e5
TTN
63 (modify-syntax-entry i "_ " st)
64 (setq i (1+ i)))
f13f86fb
CY
65 (setq i (1+ ?9))
66 (while (< i ?A)
67 (modify-syntax-entry i "_ " st)
c676c4e5 68 (setq i (1+ i)))
f13f86fb
CY
69 (setq i (1+ ?Z))
70 (while (< i ?a)
71 (modify-syntax-entry i "_ " st)
c676c4e5 72 (setq i (1+ i)))
f13f86fb
CY
73 (setq i (1+ ?z))
74 (while (< i 128)
75 (modify-syntax-entry i "_ " st)
c676c4e5
TTN
76 (setq i (1+ i)))
77
78 ;; Whitespace
79 (modify-syntax-entry ?\t " " st)
80 (modify-syntax-entry ?\n "> " st)
81 (modify-syntax-entry ?\f " " st)
82 (modify-syntax-entry ?\r " " st)
347a0b69 83 (modify-syntax-entry ?\s " " st)
c676c4e5
TTN
84
85 ;; These characters are delimiters but otherwise undefined.
86 ;; Brackets and braces balance for editing convenience.
87 (modify-syntax-entry ?\[ "(] " st)
88 (modify-syntax-entry ?\] ")[ " st)
89 (modify-syntax-entry ?{ "(} " st)
90 (modify-syntax-entry ?} "){ " st)
f17ae68f
SM
91 (modify-syntax-entry ?\| "\" 23bn" st)
92 ;; Guile allows #! ... !# comments.
93 ;; But SRFI-22 defines the comment as #!...\n instead.
94 ;; Also Guile says that the !# should be on a line of its own.
95 ;; It's too difficult to get it right, for too little benefit.
96 ;; (modify-syntax-entry ?! "_ 2" st)
c676c4e5
TTN
97
98 ;; Other atom delimiters
99 (modify-syntax-entry ?\( "() " st)
100 (modify-syntax-entry ?\) ")( " st)
21c3ef84
SM
101 ;; It's used for single-line comments as well as for #;(...) sexp-comments.
102 (modify-syntax-entry ?\; "< 2 " st)
103 (modify-syntax-entry ?\" "\" " st)
0a08535e
RS
104 (modify-syntax-entry ?' "' " st)
105 (modify-syntax-entry ?` "' " st)
c676c4e5
TTN
106
107 ;; Special characters
0a08535e
RS
108 (modify-syntax-entry ?, "' " st)
109 (modify-syntax-entry ?@ "' " st)
c5683ceb 110 (modify-syntax-entry ?# "' 14" st)
c676c4e5 111 (modify-syntax-entry ?\\ "\\ " st)
9fce950d 112 st))
ac5b21ac 113\f
d17f0db5 114(defvar scheme-mode-abbrev-table nil)
ac5b21ac
RS
115(define-abbrev-table 'scheme-mode-abbrev-table ())
116
1367ff3a 117(defvar scheme-imenu-generic-expression
d17f0db5 118 '((nil
d575e99d 119 "^(define\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)*\\s-+(?\\(\\sw+\\)" 4)
d17f0db5 120 ("Types"
d575e99d 121 "^(define-class\\s-+(?\\(\\sw+\\)" 1)
93a7d76f 122 ("Macros"
d575e99d 123 "^(\\(defmacro\\|define-macro\\|define-syntax\\)\\s-+(?\\(\\sw+\\)" 2))
1367ff3a
RS
124 "Imenu generic expression for Scheme mode. See `imenu-generic-expression'.")
125
ac5b21ac
RS
126(defun scheme-mode-variables ()
127 (set-syntax-table scheme-mode-syntax-table)
128 (setq local-abbrev-table scheme-mode-abbrev-table)
ba03d0d9
CY
129 (setq-local paragraph-start (concat "$\\|" page-delimiter))
130 (setq-local paragraph-separate paragraph-start)
131 (setq-local paragraph-ignore-fill-prefix t)
132 (setq-local fill-paragraph-function 'lisp-fill-paragraph)
1367ff3a
RS
133 ;; Adaptive fill mode gets in the way of auto-fill,
134 ;; and should make no difference for explicit fill
135 ;; because lisp-fill-paragraph should do the job.
ba03d0d9
CY
136 (setq-local adaptive-fill-mode nil)
137 (setq-local indent-line-function 'lisp-indent-line)
138 (setq-local parse-sexp-ignore-comments t)
139 (setq-local outline-regexp ";;; \\|(....")
140 (setq-local add-log-current-defun-function #'lisp-current-defun-name)
141 (setq-local comment-start ";")
142 (setq-local comment-add 1)
4f8aeb84
DG
143 (setq-local comment-start-skip ";+[ \t]*")
144 (setq-local comment-use-syntax t)
ba03d0d9
CY
145 (setq-local comment-column 40)
146 (setq-local parse-sexp-ignore-comments t)
147 (setq-local lisp-indent-function 'scheme-indent-function)
1367ff3a 148 (setq mode-line-process '("" scheme-mode-line-process))
ba03d0d9 149 (setq-local imenu-case-fold-search t)
c0b08eb0 150 (setq imenu-generic-expression scheme-imenu-generic-expression)
ba03d0d9 151 (setq-local imenu-syntax-alist
1b9a1e9d 152 '(("+-*/.<>=?!$%_&~^:" . "w")))
ba03d0d9
CY
153 (setq font-lock-defaults
154 '((scheme-font-lock-keywords
155 scheme-font-lock-keywords-1 scheme-font-lock-keywords-2)
156 nil t (("+-*/.<>=!?$%_&~^:" . "w") (?#. "w 14"))
157 beginning-of-defun
158 (font-lock-mark-block-function . mark-defun)
159 (font-lock-syntactic-face-function
160 . scheme-font-lock-syntactic-face-function)
161 (parse-sexp-lookup-properties . t)
162 (font-lock-extra-managed-props syntax-table)))
163 (setq-local lisp-doc-string-elt-property 'scheme-doc-string-elt))
ac5b21ac
RS
164
165(defvar scheme-mode-line-process "")
166
150bbae7
SM
167(defvar scheme-mode-map
168 (let ((smap (make-sparse-keymap))
169 (map (make-sparse-keymap "Scheme")))
170 (set-keymap-parent smap lisp-mode-shared-map)
171 (define-key smap [menu-bar scheme] (cons "Scheme" map))
ece8c34d
DL
172 (define-key map [run-scheme] '("Run Inferior Scheme" . run-scheme))
173 (define-key map [uncomment-region]
174 '("Uncomment Out Region" . (lambda (beg end)
175 (interactive "r")
176 (comment-region beg end '(4)))))
177 (define-key map [comment-region] '("Comment Out Region" . comment-region))
178 (define-key map [indent-region] '("Indent Region" . indent-region))
179 (define-key map [indent-line] '("Indent Line" . lisp-indent-line))
180 (put 'comment-region 'menu-enable 'mark-active)
181 (put 'uncomment-region 'menu-enable 'mark-active)
150bbae7
SM
182 (put 'indent-region 'menu-enable 'mark-active)
183 smap)
184 "Keymap for Scheme mode.
185All commands in `lisp-mode-shared-map' are inherited by this map.")
1367ff3a
RS
186
187;; Used by cmuscheme
ac5b21ac 188(defun scheme-mode-commands (map)
48879301 189 ;;(define-key map "\t" 'indent-for-tab-command) ; default
ac5b21ac 190 (define-key map "\177" 'backward-delete-char-untabify)
48879301 191 (define-key map "\e\C-q" 'indent-sexp))
ac5b21ac 192\f
e2ab0aa6 193;;;###autoload
175069ef 194(define-derived-mode scheme-mode prog-mode "Scheme"
ac5b21ac 195 "Major mode for editing Scheme code.
d17f0db5 196Editing commands are similar to those of `lisp-mode'.
ac5b21ac
RS
197
198In addition, if an inferior Scheme process is running, some additional
199commands will be defined, for evaluating expressions and controlling
200the interpreter, and the state of the process will be displayed in the
37269466 201mode line of all Scheme buffers. The names of commands that interact
1b9a1e9d
DL
202with the Scheme process start with \"xscheme-\" if you use the MIT
203Scheme-specific `xscheme' package; for more information see the
204documentation for `xscheme-interaction-mode'. Use \\[run-scheme] to
205start an inferior Scheme using the more general `cmuscheme' package.
ac5b21ac
RS
206
207Commands:
208Delete converts tabs to spaces as it moves back.
209Blank lines separate paragraphs. Semicolons start comments.
ae1f1ce1 210\\{scheme-mode-map}"
175069ef 211 (scheme-mode-variables))
ac5b21ac 212
48879301 213(defgroup scheme nil
347a0b69 214 "Editing Scheme code."
8ec3bce0 215 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
48879301
RS
216 :group 'lisp)
217
218(defcustom scheme-mit-dialect t
ac5b21ac 219 "If non-nil, scheme mode is specialized for MIT Scheme.
48879301
RS
220Set this to nil if you normally use another dialect."
221 :type 'boolean
222 :group 'scheme)
1367ff3a 223
48879301 224(defcustom dsssl-sgml-declaration
1367ff3a
RS
225 "<!DOCTYPE style-sheet PUBLIC \"-//James Clark//DTD DSSSL Style Sheet//EN\">
226"
fb7ada5f 227 "An SGML declaration for the DSSSL file.
2b20743d 228If it is defined as a string this will be inserted into an empty buffer
d17f0db5 229which is in `dsssl-mode'. It is typically James Clark's style-sheet
48879301 230doctype, as required for Jade."
d17f0db5 231 :type '(choice (string :tag "Specified string")
2b20743d
DL
232 (const :tag "None" :value nil))
233 :group 'scheme)
234
235(defcustom scheme-mode-hook nil
d17f0db5 236 "Normal hook run when entering `scheme-mode'.
2b20743d
DL
237See `run-hooks'."
238 :type 'hook
239 :group 'scheme)
240
241(defcustom dsssl-mode-hook nil
d17f0db5 242 "Normal hook run when entering `dsssl-mode'.
2b20743d
DL
243See `run-hooks'."
244 :type 'hook
48879301 245 :group 'scheme)
1367ff3a 246
f7a6110d
DL
247;; This is shared by cmuscheme and xscheme.
248(defcustom scheme-program-name "scheme"
fb7ada5f 249 "Program invoked by the `run-scheme' command."
f7a6110d
DL
250 :type 'string
251 :group 'scheme)
252
1367ff3a
RS
253(defvar dsssl-imenu-generic-expression
254 ;; Perhaps this should also look for the style-sheet DTD tags. I'm
255 ;; not sure it's the best way to organize it; perhaps one type
256 ;; should be at the first level, though you don't see this anyhow if
257 ;; it gets split up.
d17f0db5 258 '(("Defines"
d575e99d 259 "^(define\\s-+(?\\(\\sw+\\)" 1)
93a7d76f 260 ("Modes"
d575e99d 261 "^\\s-*(mode\\s-+\\(\\(\\sw\\|\\s-\\)+\\)" 1)
93a7d76f 262 ("Elements"
1367ff3a 263 ;; (element foo ...) or (element (foo bar ...) ...)
26d05e22 264 ;; Fixme: Perhaps it should do `root'.
d575e99d 265 "^\\s-*(element\\s-+(?\\(\\(\\sw\\|\\s-\\)+\\))?" 1)
d17f0db5 266 ("Declarations"
d575e99d 267 "^(declare\\(-\\sw+\\)+\\>\\s-+\\(\\sw+\\)" 2))
1367ff3a
RS
268 "Imenu generic expression for DSSSL mode. See `imenu-generic-expression'.")
269
22dcd0d1
DL
270(defconst scheme-font-lock-keywords-1
271 (eval-when-compile
272 (list
273 ;;
274 ;; Declarations. Hannes Haug <hannes.haug@student.uni-tuebingen.de> says
275 ;; this works for SOS, STklos, SCOOPS, Meroon and Tiny CLOS.
405ff5ea 276 (list (concat "(\\(define\\*?\\("
22dcd0d1 277 ;; Function names.
405ff5ea 278 "\\(\\|-public\\|-method\\|-generic\\(-procedure\\)?\\)\\|"
22dcd0d1 279 ;; Macro names, as variable names. A bit dubious, this.
1b9a1e9d 280 "\\(-syntax\\|-macro\\)\\|"
22dcd0d1
DL
281 ;; Class names.
282 "-class"
405ff5ea
RS
283 ;; Guile modules.
284 "\\|-module"
22dcd0d1
DL
285 "\\)\\)\\>"
286 ;; Any whitespace and declared object.
287 "[ \t]*(?"
288 "\\(\\sw+\\)?")
289 '(1 font-lock-keyword-face)
290 '(6 (cond ((match-beginning 3) font-lock-function-name-face)
291 ((match-beginning 5) font-lock-variable-name-face)
292 (t font-lock-type-face))
293 nil t))
294 ))
295 "Subdued expressions to highlight in Scheme modes.")
296
297(defconst scheme-font-lock-keywords-2
298 (append scheme-font-lock-keywords-1
299 (eval-when-compile
300 (list
301 ;;
302 ;; Control structures.
303 (cons
304 (concat
305 "(" (regexp-opt
306 '("begin" "call-with-current-continuation" "call/cc"
307 "call-with-input-file" "call-with-output-file" "case" "cond"
67ed8fcd 308 "do" "else" "for-each" "if" "lambda" "λ"
22dcd0d1 309 "let" "let*" "let-syntax" "letrec" "letrec-syntax"
12e5e86e
SH
310 ;; R6RS library subforms.
311 "export" "import"
12cf1a12
TTN
312 ;; SRFI 11 usage comes up often enough.
313 "let-values" "let*-values"
22dcd0d1 314 ;; Hannes Haug <hannes.haug@student.uni-tuebingen.de> wants:
c1bfdd54 315 "and" "or" "delay" "force"
22dcd0d1
DL
316 ;; Stefan Monnier <stefan.monnier@epfl.ch> says don't bother:
317 ;;"quasiquote" "quote" "unquote" "unquote-splicing"
318 "map" "syntax" "syntax-rules") t)
319 "\\>") 1)
320 ;;
22071507
TTN
321 ;; It wouldn't be Scheme w/o named-let.
322 '("(let\\s-+\\(\\sw+\\)"
323 (1 font-lock-function-name-face))
324 ;;
22dcd0d1
DL
325 ;; David Fox <fox@graphics.cs.nyu.edu> for SOS/STklos class specifiers.
326 '("\\<<\\sw+>\\>" . font-lock-type-face)
327 ;;
cb049c41
TTN
328 ;; Scheme `:' and `#:' keywords as builtins.
329 '("\\<#?:\\sw+\\>" . font-lock-builtin-face)
12e5e86e
SH
330 ;; R6RS library declarations.
331 '("(\\(\\<library\\>\\)\\s-*(?\\(\\sw+\\)?"
332 (1 font-lock-keyword-face)
333 (2 font-lock-type-face))
22dcd0d1
DL
334 )))
335 "Gaudy expressions to highlight in Scheme modes.")
336
337(defvar scheme-font-lock-keywords scheme-font-lock-keywords-1
338 "Default expressions to highlight in Scheme modes.")
339
21c3ef84
SM
340(defconst scheme-sexp-comment-syntax-table
341 (let ((st (make-syntax-table scheme-mode-syntax-table)))
342 (modify-syntax-entry ?\; "." st)
343 (modify-syntax-entry ?\n " " st)
344 (modify-syntax-entry ?# "'" st)
345 st))
346
347(put 'lambda 'scheme-doc-string-elt 2)
348;; Docstring's pos in a `define' depends on whether it's a var or fun def.
349(put 'define 'scheme-doc-string-elt
350 (lambda ()
351 ;; The function is called with point right after "define".
352 (forward-comment (point-max))
353 (if (eq (char-after) ?\() 2 0)))
354
f17ae68f 355(defun scheme-font-lock-syntactic-face-function (state)
21c3ef84
SM
356 (when (and (null (nth 3 state))
357 (eq (char-after (nth 8 state)) ?#)
358 (eq (char-after (1+ (nth 8 state))) ?\;))
359 ;; It's a sexp-comment. Tell parse-partial-sexp where it ends.
360 (save-excursion
361 (let ((pos (point))
362 (end
363 (condition-case err
364 (let ((parse-sexp-lookup-properties nil))
365 (goto-char (+ 2 (nth 8 state)))
366 ;; FIXME: this doesn't handle the case where the sexp
367 ;; itself contains a #; comment.
368 (forward-sexp 1)
369 (point))
370 (scan-error (nth 2 err)))))
371 (when (< pos (- end 2))
372 (put-text-property pos (- end 2)
373 'syntax-table scheme-sexp-comment-syntax-table))
374 (put-text-property (- end 1) end 'syntax-table '(12)))))
375 ;; Choose the face to use.
376 (lisp-font-lock-syntactic-face-function state))
f17ae68f 377
1367ff3a 378;;;###autoload
150bbae7 379(define-derived-mode dsssl-mode scheme-mode "DSSSL"
1367ff3a 380 "Major mode for editing DSSSL code.
d17f0db5 381Editing commands are similar to those of `lisp-mode'.
1367ff3a
RS
382
383Commands:
384Delete converts tabs to spaces as it moves back.
385Blank lines separate paragraphs. Semicolons start comments.
386\\{scheme-mode-map}
22dcd0d1
DL
387Entering this mode runs the hooks `scheme-mode-hook' and then
388`dsssl-mode-hook' and inserts the value of `dsssl-sgml-declaration' if
389that variable's value is a string."
ba03d0d9 390 (setq-local page-delimiter "^;;;") ; ^L not valid SGML char
1367ff3a 391 ;; Insert a suitable SGML declaration into an empty buffer.
150bbae7 392 ;; FIXME: This should use `auto-insert-alist' instead.
1367ff3a 393 (and (zerop (buffer-size))
26d05e22 394 (stringp dsssl-sgml-declaration)
1367ff3a
RS
395 (not buffer-read-only)
396 (insert dsssl-sgml-declaration))
22dcd0d1
DL
397 (setq font-lock-defaults '(dsssl-font-lock-keywords
398 nil t (("+-*/.<>=?$%_&~^:" . "w"))
399 beginning-of-defun
400 (font-lock-mark-block-function . mark-defun)))
ba03d0d9
CY
401 (setq-local add-log-current-defun-function #'lisp-current-defun-name)
402 (setq-local imenu-case-fold-search nil)
c0b08eb0 403 (setq imenu-generic-expression dsssl-imenu-generic-expression)
ba03d0d9 404 (setq-local imenu-syntax-alist '(("+-*/.<>=?$%_&~^:" . "w"))))
1367ff3a
RS
405
406;; Extra syntax for DSSSL. This isn't separated from Scheme, but
407;; shouldn't cause much trouble in scheme-mode.
408(put 'element 'scheme-indent-function 1)
409(put 'mode 'scheme-indent-function 1)
410(put 'with-mode 'scheme-indent-function 1)
2f5029f3 411(put 'make 'scheme-indent-function 1)
26d05e22
RS
412(put 'style 'scheme-indent-function 1)
413(put 'root 'scheme-indent-function 1)
67ed8fcd 414(put 'λ 'scheme-indent-function 1)
1367ff3a
RS
415
416(defvar dsssl-font-lock-keywords
26d05e22
RS
417 (eval-when-compile
418 (list
419 ;; Similar to Scheme
420 (list "(\\(define\\(-\\w+\\)?\\)\\>[ ]*\\\((?\\)\\(\\sw+\\)\\>"
421 '(1 font-lock-keyword-face)
422 '(4 font-lock-function-name-face))
423 (cons
424 (concat "(\\("
425 ;; (make-regexp '("case" "cond" "else" "if" "lambda"
426 ;; "let" "let*" "letrec" "and" "or" "map" "with-mode"))
427 "and\\|c\\(ase\\|ond\\)\\|else\\|if\\|"
428 "l\\(ambda\\|et\\(\\|*\\|rec\\)\\)\\|map\\|or\\|with-mode"
429 "\\)\\>")
430 1)
431 ;; DSSSL syntax
432 '("(\\(element\\|mode\\|declare-\\w+\\)\\>[ ]*\\(\\sw+\\)"
433 (1 font-lock-keyword-face)
434 (2 font-lock-type-face))
435 '("(\\(element\\)\\>[ ]*(\\(\\S)+\\))"
436 (1 font-lock-keyword-face)
437 (2 font-lock-type-face))
883212ce 438 '("\\<\\sw+:\\>" . font-lock-constant-face) ; trailing `:' c.f. scheme
26d05e22
RS
439 ;; SGML markup (from sgml-mode) :
440 '("<\\([!?][-a-z0-9]+\\)" 1 font-lock-keyword-face)
441 '("<\\(/?[-a-z0-9]+\\)" 1 font-lock-function-name-face)))
1367ff3a
RS
442 "Default expressions to highlight in DSSSL mode.")
443
ac5b21ac 444\f
1367ff3a
RS
445(defvar calculate-lisp-indent-last-sexp)
446
b7556719
GM
447
448;; FIXME this duplicates almost all of lisp-indent-function.
449;; Extract common code to a subroutine.
ac5b21ac 450(defun scheme-indent-function (indent-point state)
b7556719
GM
451 "Scheme mode function for the value of the variable `lisp-indent-function'.
452This behaves like the function `lisp-indent-function', except that:
453
454i) it checks for a non-nil value of the property `scheme-indent-function'
dd4b63a6 455\(or the deprecated `scheme-indent-hook'), rather than `lisp-indent-function'.
b7556719 456
b026d240 457ii) if that property specifies a function, it is called with three
b7556719
GM
458arguments (not two), the third argument being the default (i.e., current)
459indentation."
ac5b21ac 460 (let ((normal-indent (current-column)))
1367ff3a
RS
461 (goto-char (1+ (elt state 1)))
462 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
463 (if (and (elt state 2)
464 (not (looking-at "\\sw\\|\\s_")))
4696802b 465 ;; car of form doesn't seem to be a symbol
1367ff3a
RS
466 (progn
467 (if (not (> (save-excursion (forward-line 1) (point))
468 calculate-lisp-indent-last-sexp))
469 (progn (goto-char calculate-lisp-indent-last-sexp)
470 (beginning-of-line)
471 (parse-partial-sexp (point)
472 calculate-lisp-indent-last-sexp 0 t)))
473 ;; Indent under the list or under the first sexp on the same
474 ;; line as calculate-lisp-indent-last-sexp. Note that first
475 ;; thing on that line has to be complete sexp since we are
476 ;; inside the innermost containing sexp.
477 (backward-prefix-chars)
478 (current-column))
479 (let ((function (buffer-substring (point)
480 (progn (forward-sexp 1) (point))))
481 method)
482 (setq method (or (get (intern-soft function) 'scheme-indent-function)
483 (get (intern-soft function) 'scheme-indent-hook)))
484 (cond ((or (eq method 'defun)
485 (and (null method)
486 (> (length function) 3)
487 (string-match "\\`def" function)))
488 (lisp-indent-defform state indent-point))
489 ((integerp method)
490 (lisp-indent-specform method state
491 indent-point normal-indent))
492 (method
61185f42 493 (funcall method state indent-point normal-indent)))))))
1367ff3a 494
ac5b21ac
RS
495\f
496;;; Let is different in Scheme
497
d5031a2a
LL
498;; (defun scheme-would-be-symbol (string)
499;; (not (string-equal (substring string 0 1) "(")))
ac5b21ac 500
d5031a2a
LL
501;; (defun scheme-next-sexp-as-string ()
502;; ;; Assumes that it is protected by a save-excursion
503;; (forward-sexp 1)
504;; (let ((the-end (point)))
505;; (backward-sexp 1)
506;; (buffer-substring (point) the-end)))
ac5b21ac
RS
507
508;; This is correct but too slow.
509;; The one below works almost always.
510;;(defun scheme-let-indent (state indent-point)
d5031a2a 511;; (if (scheme-would-be-symbol (scheme-next-sexp-as-string))
ac5b21ac
RS
512;; (scheme-indent-specform 2 state indent-point)
513;; (scheme-indent-specform 1 state indent-point)))
514
61185f42 515(defun scheme-let-indent (state indent-point normal-indent)
ac5b21ac 516 (skip-chars-forward " \t")
61361a07 517 (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]")
61185f42
KH
518 (lisp-indent-specform 2 state indent-point normal-indent)
519 (lisp-indent-specform 1 state indent-point normal-indent)))
ac5b21ac
RS
520
521;; (put 'begin 'scheme-indent-function 0), say, causes begin to be indented
522;; like defun if the first form is placed on the next line, otherwise
523;; it is indented like any other form (i.e. forms line up under first).
524
525(put 'begin 'scheme-indent-function 0)
526(put 'case 'scheme-indent-function 1)
527(put 'delay 'scheme-indent-function 0)
528(put 'do 'scheme-indent-function 2)
529(put 'lambda 'scheme-indent-function 1)
530(put 'let 'scheme-indent-function 'scheme-let-indent)
531(put 'let* 'scheme-indent-function 1)
532(put 'letrec 'scheme-indent-function 1)
12cf1a12
TTN
533(put 'let-values 'scheme-indent-function 1) ; SRFI 11
534(put 'let*-values 'scheme-indent-function 1) ; SRFI 11
2b20743d
DL
535(put 'sequence 'scheme-indent-function 0) ; SICP, not r4rs
536(put 'let-syntax 'scheme-indent-function 1)
537(put 'letrec-syntax 'scheme-indent-function 1)
538(put 'syntax-rules 'scheme-indent-function 1)
0ec2c350 539(put 'syntax-case 'scheme-indent-function 2) ; not r5rs
12e5e86e 540(put 'library 'scheme-indent-function 1) ; R6RS
ac5b21ac
RS
541
542(put 'call-with-input-file 'scheme-indent-function 1)
543(put 'with-input-from-file 'scheme-indent-function 1)
544(put 'with-input-from-port 'scheme-indent-function 1)
545(put 'call-with-output-file 'scheme-indent-function 1)
546(put 'with-output-to-file 'scheme-indent-function 1)
547(put 'with-output-to-port 'scheme-indent-function 1)
2b20743d
DL
548(put 'call-with-values 'scheme-indent-function 1) ; r5rs?
549(put 'dynamic-wind 'scheme-indent-function 3) ; r5rs?
ac5b21ac
RS
550\f
551;;;; MIT Scheme specific indentation.
552
553(if scheme-mit-dialect
554 (progn
555 (put 'fluid-let 'scheme-indent-function 1)
556 (put 'in-package 'scheme-indent-function 1)
ac5b21ac
RS
557 (put 'local-declare 'scheme-indent-function 1)
558 (put 'macro 'scheme-indent-function 1)
559 (put 'make-environment 'scheme-indent-function 0)
560 (put 'named-lambda 'scheme-indent-function 1)
561 (put 'using-syntax 'scheme-indent-function 1)
562
563 (put 'with-input-from-string 'scheme-indent-function 1)
564 (put 'with-output-to-string 'scheme-indent-function 0)
565 (put 'with-values 'scheme-indent-function 1)
566
567 (put 'syntax-table-define 'scheme-indent-function 2)
568 (put 'list-transform-positive 'scheme-indent-function 1)
569 (put 'list-transform-negative 'scheme-indent-function 1)
570 (put 'list-search-positive 'scheme-indent-function 1)
571 (put 'list-search-negative 'scheme-indent-function 1)
572
573 (put 'access-components 'scheme-indent-function 1)
574 (put 'assignment-components 'scheme-indent-function 1)
575 (put 'combination-components 'scheme-indent-function 1)
576 (put 'comment-components 'scheme-indent-function 1)
577 (put 'conditional-components 'scheme-indent-function 1)
578 (put 'disjunction-components 'scheme-indent-function 1)
579 (put 'declaration-components 'scheme-indent-function 1)
580 (put 'definition-components 'scheme-indent-function 1)
581 (put 'delay-components 'scheme-indent-function 1)
582 (put 'in-package-components 'scheme-indent-function 1)
583 (put 'lambda-components 'scheme-indent-function 1)
584 (put 'lambda-components* 'scheme-indent-function 1)
585 (put 'lambda-components** 'scheme-indent-function 1)
586 (put 'open-block-components 'scheme-indent-function 1)
587 (put 'pathname-components 'scheme-indent-function 1)
588 (put 'procedure-components 'scheme-indent-function 1)
589 (put 'sequence-components 'scheme-indent-function 1)
590 (put 'unassigned\?-components 'scheme-indent-function 1)
591 (put 'unbound\?-components 'scheme-indent-function 1)
592 (put 'variable-components 'scheme-indent-function 1)))
49116ac0
JB
593
594(provide 'scheme)
c88ab9ce
ER
595
596;;; scheme.el ends here