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