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