* term/xterm.el (xterm--query): Stop after first matching handler. (Bug#14615)
[bpt/emacs.git] / lisp / progmodes / scheme.el
CommitLineData
e8af40ee 1;;; scheme.el --- Scheme (and DSSSL) editing mode
c88ab9ce 2
ab422c4d
PE
3;; Copyright (C) 1986-1988, 1997-1998, 2001-2013 Free Software
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)
a24c42f7
MB
143 ;; Look within the line for a ; following an even number of backslashes
144 ;; after either a non-backslash or the line beginning.
ba03d0d9
CY
145 (setq-local comment-start-skip
146 "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
147 (setq-local font-lock-comment-start-skip ";+ *")
148 (setq-local comment-column 40)
149 (setq-local parse-sexp-ignore-comments t)
150 (setq-local lisp-indent-function 'scheme-indent-function)
1367ff3a 151 (setq mode-line-process '("" scheme-mode-line-process))
ba03d0d9 152 (setq-local imenu-case-fold-search t)
c0b08eb0 153 (setq imenu-generic-expression scheme-imenu-generic-expression)
ba03d0d9 154 (setq-local imenu-syntax-alist
1b9a1e9d 155 '(("+-*/.<>=?!$%_&~^:" . "w")))
ba03d0d9
CY
156 (setq font-lock-defaults
157 '((scheme-font-lock-keywords
158 scheme-font-lock-keywords-1 scheme-font-lock-keywords-2)
159 nil t (("+-*/.<>=!?$%_&~^:" . "w") (?#. "w 14"))
160 beginning-of-defun
161 (font-lock-mark-block-function . mark-defun)
162 (font-lock-syntactic-face-function
163 . scheme-font-lock-syntactic-face-function)
164 (parse-sexp-lookup-properties . t)
165 (font-lock-extra-managed-props syntax-table)))
166 (setq-local lisp-doc-string-elt-property 'scheme-doc-string-elt))
ac5b21ac
RS
167
168(defvar scheme-mode-line-process "")
169
150bbae7
SM
170(defvar scheme-mode-map
171 (let ((smap (make-sparse-keymap))
172 (map (make-sparse-keymap "Scheme")))
173 (set-keymap-parent smap lisp-mode-shared-map)
174 (define-key smap [menu-bar scheme] (cons "Scheme" map))
ece8c34d
DL
175 (define-key map [run-scheme] '("Run Inferior Scheme" . run-scheme))
176 (define-key map [uncomment-region]
177 '("Uncomment Out Region" . (lambda (beg end)
178 (interactive "r")
179 (comment-region beg end '(4)))))
180 (define-key map [comment-region] '("Comment Out Region" . comment-region))
181 (define-key map [indent-region] '("Indent Region" . indent-region))
182 (define-key map [indent-line] '("Indent Line" . lisp-indent-line))
183 (put 'comment-region 'menu-enable 'mark-active)
184 (put 'uncomment-region 'menu-enable 'mark-active)
150bbae7
SM
185 (put 'indent-region 'menu-enable 'mark-active)
186 smap)
187 "Keymap for Scheme mode.
188All commands in `lisp-mode-shared-map' are inherited by this map.")
1367ff3a
RS
189
190;; Used by cmuscheme
ac5b21ac 191(defun scheme-mode-commands (map)
48879301 192 ;;(define-key map "\t" 'indent-for-tab-command) ; default
ac5b21ac 193 (define-key map "\177" 'backward-delete-char-untabify)
48879301 194 (define-key map "\e\C-q" 'indent-sexp))
ac5b21ac 195\f
e2ab0aa6 196;;;###autoload
175069ef 197(define-derived-mode scheme-mode prog-mode "Scheme"
ac5b21ac 198 "Major mode for editing Scheme code.
d17f0db5 199Editing commands are similar to those of `lisp-mode'.
ac5b21ac
RS
200
201In addition, if an inferior Scheme process is running, some additional
202commands will be defined, for evaluating expressions and controlling
203the interpreter, and the state of the process will be displayed in the
37269466 204mode line of all Scheme buffers. The names of commands that interact
1b9a1e9d
DL
205with the Scheme process start with \"xscheme-\" if you use the MIT
206Scheme-specific `xscheme' package; for more information see the
207documentation for `xscheme-interaction-mode'. Use \\[run-scheme] to
208start an inferior Scheme using the more general `cmuscheme' package.
ac5b21ac
RS
209
210Commands:
211Delete converts tabs to spaces as it moves back.
212Blank lines separate paragraphs. Semicolons start comments.
213\\{scheme-mode-map}
d17f0db5 214Entry to this mode calls the value of `scheme-mode-hook'
ac5b21ac 215if that value is non-nil."
175069ef 216 (scheme-mode-variables))
ac5b21ac 217
48879301 218(defgroup scheme nil
347a0b69 219 "Editing Scheme code."
8ec3bce0 220 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
48879301
RS
221 :group 'lisp)
222
223(defcustom scheme-mit-dialect t
ac5b21ac 224 "If non-nil, scheme mode is specialized for MIT Scheme.
48879301
RS
225Set this to nil if you normally use another dialect."
226 :type 'boolean
227 :group 'scheme)
1367ff3a 228
48879301 229(defcustom dsssl-sgml-declaration
1367ff3a
RS
230 "<!DOCTYPE style-sheet PUBLIC \"-//James Clark//DTD DSSSL Style Sheet//EN\">
231"
fb7ada5f 232 "An SGML declaration for the DSSSL file.
2b20743d 233If it is defined as a string this will be inserted into an empty buffer
d17f0db5 234which is in `dsssl-mode'. It is typically James Clark's style-sheet
48879301 235doctype, as required for Jade."
d17f0db5 236 :type '(choice (string :tag "Specified string")
2b20743d
DL
237 (const :tag "None" :value nil))
238 :group 'scheme)
239
240(defcustom scheme-mode-hook nil
d17f0db5 241 "Normal hook run when entering `scheme-mode'.
2b20743d
DL
242See `run-hooks'."
243 :type 'hook
244 :group 'scheme)
245
246(defcustom dsssl-mode-hook nil
d17f0db5 247 "Normal hook run when entering `dsssl-mode'.
2b20743d
DL
248See `run-hooks'."
249 :type 'hook
48879301 250 :group 'scheme)
1367ff3a 251
f7a6110d
DL
252;; This is shared by cmuscheme and xscheme.
253(defcustom scheme-program-name "scheme"
fb7ada5f 254 "Program invoked by the `run-scheme' command."
f7a6110d
DL
255 :type 'string
256 :group 'scheme)
257
1367ff3a
RS
258(defvar dsssl-imenu-generic-expression
259 ;; Perhaps this should also look for the style-sheet DTD tags. I'm
260 ;; not sure it's the best way to organize it; perhaps one type
261 ;; should be at the first level, though you don't see this anyhow if
262 ;; it gets split up.
d17f0db5 263 '(("Defines"
d575e99d 264 "^(define\\s-+(?\\(\\sw+\\)" 1)
93a7d76f 265 ("Modes"
d575e99d 266 "^\\s-*(mode\\s-+\\(\\(\\sw\\|\\s-\\)+\\)" 1)
93a7d76f 267 ("Elements"
1367ff3a 268 ;; (element foo ...) or (element (foo bar ...) ...)
26d05e22 269 ;; Fixme: Perhaps it should do `root'.
d575e99d 270 "^\\s-*(element\\s-+(?\\(\\(\\sw\\|\\s-\\)+\\))?" 1)
d17f0db5 271 ("Declarations"
d575e99d 272 "^(declare\\(-\\sw+\\)+\\>\\s-+\\(\\sw+\\)" 2))
1367ff3a
RS
273 "Imenu generic expression for DSSSL mode. See `imenu-generic-expression'.")
274
22dcd0d1
DL
275(defconst scheme-font-lock-keywords-1
276 (eval-when-compile
277 (list
278 ;;
279 ;; Declarations. Hannes Haug <hannes.haug@student.uni-tuebingen.de> says
280 ;; this works for SOS, STklos, SCOOPS, Meroon and Tiny CLOS.
405ff5ea 281 (list (concat "(\\(define\\*?\\("
22dcd0d1 282 ;; Function names.
405ff5ea 283 "\\(\\|-public\\|-method\\|-generic\\(-procedure\\)?\\)\\|"
22dcd0d1 284 ;; Macro names, as variable names. A bit dubious, this.
1b9a1e9d 285 "\\(-syntax\\|-macro\\)\\|"
22dcd0d1
DL
286 ;; Class names.
287 "-class"
405ff5ea
RS
288 ;; Guile modules.
289 "\\|-module"
22dcd0d1
DL
290 "\\)\\)\\>"
291 ;; Any whitespace and declared object.
292 "[ \t]*(?"
293 "\\(\\sw+\\)?")
294 '(1 font-lock-keyword-face)
295 '(6 (cond ((match-beginning 3) font-lock-function-name-face)
296 ((match-beginning 5) font-lock-variable-name-face)
297 (t font-lock-type-face))
298 nil t))
299 ))
300 "Subdued expressions to highlight in Scheme modes.")
301
302(defconst scheme-font-lock-keywords-2
303 (append scheme-font-lock-keywords-1
304 (eval-when-compile
305 (list
306 ;;
307 ;; Control structures.
308 (cons
309 (concat
310 "(" (regexp-opt
311 '("begin" "call-with-current-continuation" "call/cc"
312 "call-with-input-file" "call-with-output-file" "case" "cond"
67ed8fcd 313 "do" "else" "for-each" "if" "lambda" "λ"
22dcd0d1 314 "let" "let*" "let-syntax" "letrec" "letrec-syntax"
12cf1a12
TTN
315 ;; SRFI 11 usage comes up often enough.
316 "let-values" "let*-values"
22dcd0d1 317 ;; Hannes Haug <hannes.haug@student.uni-tuebingen.de> wants:
c1bfdd54 318 "and" "or" "delay" "force"
22dcd0d1
DL
319 ;; Stefan Monnier <stefan.monnier@epfl.ch> says don't bother:
320 ;;"quasiquote" "quote" "unquote" "unquote-splicing"
321 "map" "syntax" "syntax-rules") t)
322 "\\>") 1)
323 ;;
22071507
TTN
324 ;; It wouldn't be Scheme w/o named-let.
325 '("(let\\s-+\\(\\sw+\\)"
326 (1 font-lock-function-name-face))
327 ;;
22dcd0d1
DL
328 ;; David Fox <fox@graphics.cs.nyu.edu> for SOS/STklos class specifiers.
329 '("\\<<\\sw+>\\>" . font-lock-type-face)
330 ;;
cb049c41
TTN
331 ;; Scheme `:' and `#:' keywords as builtins.
332 '("\\<#?:\\sw+\\>" . font-lock-builtin-face)
22dcd0d1
DL
333 )))
334 "Gaudy expressions to highlight in Scheme modes.")
335
336(defvar scheme-font-lock-keywords scheme-font-lock-keywords-1
337 "Default expressions to highlight in Scheme modes.")
338
21c3ef84
SM
339(defconst scheme-sexp-comment-syntax-table
340 (let ((st (make-syntax-table scheme-mode-syntax-table)))
341 (modify-syntax-entry ?\; "." st)
342 (modify-syntax-entry ?\n " " st)
343 (modify-syntax-entry ?# "'" st)
344 st))
345
346(put 'lambda 'scheme-doc-string-elt 2)
347;; Docstring's pos in a `define' depends on whether it's a var or fun def.
348(put 'define 'scheme-doc-string-elt
349 (lambda ()
350 ;; The function is called with point right after "define".
351 (forward-comment (point-max))
352 (if (eq (char-after) ?\() 2 0)))
353
f17ae68f 354(defun scheme-font-lock-syntactic-face-function (state)
21c3ef84
SM
355 (when (and (null (nth 3 state))
356 (eq (char-after (nth 8 state)) ?#)
357 (eq (char-after (1+ (nth 8 state))) ?\;))
358 ;; It's a sexp-comment. Tell parse-partial-sexp where it ends.
359 (save-excursion
360 (let ((pos (point))
361 (end
362 (condition-case err
363 (let ((parse-sexp-lookup-properties nil))
364 (goto-char (+ 2 (nth 8 state)))
365 ;; FIXME: this doesn't handle the case where the sexp
366 ;; itself contains a #; comment.
367 (forward-sexp 1)
368 (point))
369 (scan-error (nth 2 err)))))
370 (when (< pos (- end 2))
371 (put-text-property pos (- end 2)
372 'syntax-table scheme-sexp-comment-syntax-table))
373 (put-text-property (- end 1) end 'syntax-table '(12)))))
374 ;; Choose the face to use.
375 (lisp-font-lock-syntactic-face-function state))
f17ae68f 376
1367ff3a 377;;;###autoload
150bbae7 378(define-derived-mode dsssl-mode scheme-mode "DSSSL"
1367ff3a 379 "Major mode for editing DSSSL code.
d17f0db5 380Editing commands are similar to those of `lisp-mode'.
1367ff3a
RS
381
382Commands:
383Delete converts tabs to spaces as it moves back.
384Blank lines separate paragraphs. Semicolons start comments.
385\\{scheme-mode-map}
22dcd0d1
DL
386Entering this mode runs the hooks `scheme-mode-hook' and then
387`dsssl-mode-hook' and inserts the value of `dsssl-sgml-declaration' if
388that variable's value is a string."
ba03d0d9 389 (setq-local page-delimiter "^;;;") ; ^L not valid SGML char
1367ff3a 390 ;; Insert a suitable SGML declaration into an empty buffer.
150bbae7 391 ;; FIXME: This should use `auto-insert-alist' instead.
1367ff3a 392 (and (zerop (buffer-size))
26d05e22 393 (stringp dsssl-sgml-declaration)
1367ff3a
RS
394 (not buffer-read-only)
395 (insert dsssl-sgml-declaration))
22dcd0d1
DL
396 (setq font-lock-defaults '(dsssl-font-lock-keywords
397 nil t (("+-*/.<>=?$%_&~^:" . "w"))
398 beginning-of-defun
399 (font-lock-mark-block-function . mark-defun)))
ba03d0d9
CY
400 (setq-local add-log-current-defun-function #'lisp-current-defun-name)
401 (setq-local imenu-case-fold-search nil)
c0b08eb0 402 (setq imenu-generic-expression dsssl-imenu-generic-expression)
ba03d0d9 403 (setq-local imenu-syntax-alist '(("+-*/.<>=?$%_&~^:" . "w"))))
1367ff3a
RS
404
405;; Extra syntax for DSSSL. This isn't separated from Scheme, but
406;; shouldn't cause much trouble in scheme-mode.
407(put 'element 'scheme-indent-function 1)
408(put 'mode 'scheme-indent-function 1)
409(put 'with-mode 'scheme-indent-function 1)
2f5029f3 410(put 'make 'scheme-indent-function 1)
26d05e22
RS
411(put 'style 'scheme-indent-function 1)
412(put 'root 'scheme-indent-function 1)
67ed8fcd 413(put 'λ 'scheme-indent-function 1)
1367ff3a
RS
414
415(defvar dsssl-font-lock-keywords
26d05e22
RS
416 (eval-when-compile
417 (list
418 ;; Similar to Scheme
419 (list "(\\(define\\(-\\w+\\)?\\)\\>[ ]*\\\((?\\)\\(\\sw+\\)\\>"
420 '(1 font-lock-keyword-face)
421 '(4 font-lock-function-name-face))
422 (cons
423 (concat "(\\("
424 ;; (make-regexp '("case" "cond" "else" "if" "lambda"
425 ;; "let" "let*" "letrec" "and" "or" "map" "with-mode"))
426 "and\\|c\\(ase\\|ond\\)\\|else\\|if\\|"
427 "l\\(ambda\\|et\\(\\|*\\|rec\\)\\)\\|map\\|or\\|with-mode"
428 "\\)\\>")
429 1)
430 ;; DSSSL syntax
431 '("(\\(element\\|mode\\|declare-\\w+\\)\\>[ ]*\\(\\sw+\\)"
432 (1 font-lock-keyword-face)
433 (2 font-lock-type-face))
434 '("(\\(element\\)\\>[ ]*(\\(\\S)+\\))"
435 (1 font-lock-keyword-face)
436 (2 font-lock-type-face))
883212ce 437 '("\\<\\sw+:\\>" . font-lock-constant-face) ; trailing `:' c.f. scheme
26d05e22
RS
438 ;; SGML markup (from sgml-mode) :
439 '("<\\([!?][-a-z0-9]+\\)" 1 font-lock-keyword-face)
440 '("<\\(/?[-a-z0-9]+\\)" 1 font-lock-function-name-face)))
1367ff3a
RS
441 "Default expressions to highlight in DSSSL mode.")
442
ac5b21ac 443\f
1367ff3a
RS
444(defvar calculate-lisp-indent-last-sexp)
445
b7556719
GM
446
447;; FIXME this duplicates almost all of lisp-indent-function.
448;; Extract common code to a subroutine.
ac5b21ac 449(defun scheme-indent-function (indent-point state)
b7556719
GM
450 "Scheme mode function for the value of the variable `lisp-indent-function'.
451This behaves like the function `lisp-indent-function', except that:
452
453i) it checks for a non-nil value of the property `scheme-indent-function'
dd4b63a6 454\(or the deprecated `scheme-indent-hook'), rather than `lisp-indent-function'.
b7556719 455
b026d240 456ii) if that property specifies a function, it is called with three
b7556719
GM
457arguments (not two), the third argument being the default (i.e., current)
458indentation."
ac5b21ac 459 (let ((normal-indent (current-column)))
1367ff3a
RS
460 (goto-char (1+ (elt state 1)))
461 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
462 (if (and (elt state 2)
463 (not (looking-at "\\sw\\|\\s_")))
4696802b 464 ;; car of form doesn't seem to be a symbol
1367ff3a
RS
465 (progn
466 (if (not (> (save-excursion (forward-line 1) (point))
467 calculate-lisp-indent-last-sexp))
468 (progn (goto-char calculate-lisp-indent-last-sexp)
469 (beginning-of-line)
470 (parse-partial-sexp (point)
471 calculate-lisp-indent-last-sexp 0 t)))
472 ;; Indent under the list or under the first sexp on the same
473 ;; line as calculate-lisp-indent-last-sexp. Note that first
474 ;; thing on that line has to be complete sexp since we are
475 ;; inside the innermost containing sexp.
476 (backward-prefix-chars)
477 (current-column))
478 (let ((function (buffer-substring (point)
479 (progn (forward-sexp 1) (point))))
480 method)
481 (setq method (or (get (intern-soft function) 'scheme-indent-function)
482 (get (intern-soft function) 'scheme-indent-hook)))
483 (cond ((or (eq method 'defun)
484 (and (null method)
485 (> (length function) 3)
486 (string-match "\\`def" function)))
487 (lisp-indent-defform state indent-point))
488 ((integerp method)
489 (lisp-indent-specform method state
490 indent-point normal-indent))
491 (method
61185f42 492 (funcall method state indent-point normal-indent)))))))
1367ff3a 493
ac5b21ac
RS
494\f
495;;; Let is different in Scheme
496
497(defun would-be-symbol (string)
498 (not (string-equal (substring string 0 1) "(")))
499
500(defun next-sexp-as-string ()
d17f0db5 501 ;; Assumes that it is protected by a save-excursion
ac5b21ac
RS
502 (forward-sexp 1)
503 (let ((the-end (point)))
504 (backward-sexp 1)
505 (buffer-substring (point) the-end)))
506
507;; This is correct but too slow.
508;; The one below works almost always.
509;;(defun scheme-let-indent (state indent-point)
510;; (if (would-be-symbol (next-sexp-as-string))
511;; (scheme-indent-specform 2 state indent-point)
512;; (scheme-indent-specform 1 state indent-point)))
513
61185f42 514(defun scheme-let-indent (state indent-point normal-indent)
ac5b21ac 515 (skip-chars-forward " \t")
61361a07 516 (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]")
61185f42
KH
517 (lisp-indent-specform 2 state indent-point normal-indent)
518 (lisp-indent-specform 1 state indent-point normal-indent)))
ac5b21ac
RS
519
520;; (put 'begin 'scheme-indent-function 0), say, causes begin to be indented
521;; like defun if the first form is placed on the next line, otherwise
522;; it is indented like any other form (i.e. forms line up under first).
523
524(put 'begin 'scheme-indent-function 0)
525(put 'case 'scheme-indent-function 1)
526(put 'delay 'scheme-indent-function 0)
527(put 'do 'scheme-indent-function 2)
528(put 'lambda 'scheme-indent-function 1)
529(put 'let 'scheme-indent-function 'scheme-let-indent)
530(put 'let* 'scheme-indent-function 1)
531(put 'letrec 'scheme-indent-function 1)
12cf1a12
TTN
532(put 'let-values 'scheme-indent-function 1) ; SRFI 11
533(put 'let*-values 'scheme-indent-function 1) ; SRFI 11
2b20743d
DL
534(put 'sequence 'scheme-indent-function 0) ; SICP, not r4rs
535(put 'let-syntax 'scheme-indent-function 1)
536(put 'letrec-syntax 'scheme-indent-function 1)
537(put 'syntax-rules 'scheme-indent-function 1)
0ec2c350 538(put 'syntax-case 'scheme-indent-function 2) ; not r5rs
ac5b21ac
RS
539
540(put 'call-with-input-file 'scheme-indent-function 1)
541(put 'with-input-from-file 'scheme-indent-function 1)
542(put 'with-input-from-port 'scheme-indent-function 1)
543(put 'call-with-output-file 'scheme-indent-function 1)
544(put 'with-output-to-file 'scheme-indent-function 1)
545(put 'with-output-to-port 'scheme-indent-function 1)
2b20743d
DL
546(put 'call-with-values 'scheme-indent-function 1) ; r5rs?
547(put 'dynamic-wind 'scheme-indent-function 3) ; r5rs?
ac5b21ac
RS
548\f
549;;;; MIT Scheme specific indentation.
550
551(if scheme-mit-dialect
552 (progn
553 (put 'fluid-let 'scheme-indent-function 1)
554 (put 'in-package 'scheme-indent-function 1)
ac5b21ac
RS
555 (put 'local-declare 'scheme-indent-function 1)
556 (put 'macro 'scheme-indent-function 1)
557 (put 'make-environment 'scheme-indent-function 0)
558 (put 'named-lambda 'scheme-indent-function 1)
559 (put 'using-syntax 'scheme-indent-function 1)
560
561 (put 'with-input-from-string 'scheme-indent-function 1)
562 (put 'with-output-to-string 'scheme-indent-function 0)
563 (put 'with-values 'scheme-indent-function 1)
564
565 (put 'syntax-table-define 'scheme-indent-function 2)
566 (put 'list-transform-positive 'scheme-indent-function 1)
567 (put 'list-transform-negative 'scheme-indent-function 1)
568 (put 'list-search-positive 'scheme-indent-function 1)
569 (put 'list-search-negative 'scheme-indent-function 1)
570
571 (put 'access-components 'scheme-indent-function 1)
572 (put 'assignment-components 'scheme-indent-function 1)
573 (put 'combination-components 'scheme-indent-function 1)
574 (put 'comment-components 'scheme-indent-function 1)
575 (put 'conditional-components 'scheme-indent-function 1)
576 (put 'disjunction-components 'scheme-indent-function 1)
577 (put 'declaration-components 'scheme-indent-function 1)
578 (put 'definition-components 'scheme-indent-function 1)
579 (put 'delay-components 'scheme-indent-function 1)
580 (put 'in-package-components 'scheme-indent-function 1)
581 (put 'lambda-components 'scheme-indent-function 1)
582 (put 'lambda-components* 'scheme-indent-function 1)
583 (put 'lambda-components** 'scheme-indent-function 1)
584 (put 'open-block-components 'scheme-indent-function 1)
585 (put 'pathname-components 'scheme-indent-function 1)
586 (put 'procedure-components 'scheme-indent-function 1)
587 (put 'sequence-components 'scheme-indent-function 1)
588 (put 'unassigned\?-components 'scheme-indent-function 1)
589 (put 'unbound\?-components 'scheme-indent-function 1)
590 (put 'variable-components 'scheme-indent-function 1)))
49116ac0
JB
591
592(provide 'scheme)
c88ab9ce
ER
593
594;;; scheme.el ends here