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