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