1 ;;; scheme.el --- Scheme (and DSSSL) editing mode.
3 ;; Copyright (C) 1986, 87, 88, 97, 1998 Free Software Foundation, Inc.
5 ;; Author: Bill Rozas <jinx@martigny.ai.mit.edu>
6 ;; Adapted-by: Dave Love <d.love@dl.ac.uk>
7 ;; Keywords: languages, lisp
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 ;; The major mode for editing Scheme-type Lisp code, very similar to
29 ;; the Lisp mode documented in the Emacs manual. `dsssl-mode' is a
30 ;; variant of scheme-mode for editing DSSSL specifications for SGML
31 ;; documents. [As of Apr 1997, some pointers for DSSSL may be found,
32 ;; for instance, at <URL:http://www.sil.org/sgml/related.html#dsssl>.]
33 ;; All these Lisp-ish modes vary basically in details of the language
34 ;; syntax they highlight/indent/index, but dsssl-mode uses "^;;;" as
35 ;; the page-delimiter since ^L isn't normally a legal SGML character.
37 ;; For interacting with a Scheme interpreter See also `run-scheme' in
38 ;; the `cmuscheme' package and also the implementation-specific
41 ;; Here's a recipe to generate a TAGS file for DSSSL, by the way:
42 ;; etags --lang=scheme --regex='/[ \t]*(\(mode\|element\)[ \t
44 ;; ]+\)/\2/' --regex='/[ \t]*(element[ \t
47 ;; ]*)/\1/' --regex='/(declare[^ \t
56 (defvar scheme-mode-syntax-table nil "")
57 (if (not scheme-mode-syntax-table)
59 (setq scheme-mode-syntax-table (make-syntax-table))
60 (set-syntax-table scheme-mode-syntax-table)
62 ;; Default is atom-constituent.
64 (modify-syntax-entry i "_ ")
70 (modify-syntax-entry i "w ")
74 (modify-syntax-entry i "w ")
78 (modify-syntax-entry i "w ")
82 (modify-syntax-entry ?\t " ")
83 (modify-syntax-entry ?\n "> ")
84 (modify-syntax-entry ?\f " ")
85 (modify-syntax-entry ?\r " ")
86 (modify-syntax-entry ? " ")
88 ;; These characters are delimiters but otherwise undefined.
89 ;; Brackets and braces balance for editing convenience.
90 (modify-syntax-entry ?\[ "(] ")
91 (modify-syntax-entry ?\] ")[ ")
92 (modify-syntax-entry ?{ "(} ")
93 (modify-syntax-entry ?} "){ ")
94 (modify-syntax-entry ?\| " 23")
96 ;; Other atom delimiters
97 (modify-syntax-entry ?\( "() ")
98 (modify-syntax-entry ?\) ")( ")
99 (modify-syntax-entry ?\; "< ")
100 (modify-syntax-entry ?\" "\" ")
101 (modify-syntax-entry ?' " p")
102 (modify-syntax-entry ?` " p")
104 ;; Special characters
105 (modify-syntax-entry ?, "_ p")
106 (modify-syntax-entry ?@ "_ p")
107 (modify-syntax-entry ?# "_ p14")
108 (modify-syntax-entry ?\\ "\\ ")))
110 (defvar scheme-mode-abbrev-table nil "")
111 (define-abbrev-table 'scheme-mode-abbrev-table ())
113 (defvar scheme-imenu-generic-expression
115 "^(define\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)*\\s-+(?\\(\\sw+\\)" 4)
117 "^(define-class\\s-+(?\\(\\sw+\\)" 1)
119 "^(\\(defmacro\\|define-macro\\|define-syntax\\)\\s-+(?\\(\\sw+\\)" 2))
120 "Imenu generic expression for Scheme mode. See `imenu-generic-expression'.")
122 (defun scheme-mode-variables ()
123 (set-syntax-table scheme-mode-syntax-table)
124 (setq local-abbrev-table scheme-mode-abbrev-table)
125 (make-local-variable 'paragraph-start)
126 (setq paragraph-start (concat "$\\|" page-delimiter))
127 (make-local-variable 'paragraph-separate)
128 (setq paragraph-separate paragraph-start)
129 (make-local-variable 'paragraph-ignore-fill-prefix)
130 (setq paragraph-ignore-fill-prefix t)
131 (make-local-variable 'fill-paragraph-function)
132 (setq fill-paragraph-function 'lisp-fill-paragraph)
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.
136 (make-local-variable 'adaptive-fill-mode)
137 (setq adaptive-fill-mode nil)
138 (make-local-variable 'normal-auto-fill-function)
139 (setq normal-auto-fill-function 'lisp-mode-auto-fill)
140 (make-local-variable 'indent-line-function)
141 (setq indent-line-function 'lisp-indent-line)
142 (make-local-variable 'parse-sexp-ignore-comments)
143 (setq parse-sexp-ignore-comments t)
144 (make-local-variable 'outline-regexp)
145 (setq outline-regexp ";;; \\|(....")
146 (make-local-variable 'comment-start)
147 (setq comment-start ";")
148 (make-local-variable 'comment-start-skip)
149 ;; Look within the line for a ; following an even number of backslashes
150 ;; after either a non-backslash or the line beginning.
151 (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
152 (make-local-variable 'comment-column)
153 (setq comment-column 40)
154 (make-local-variable 'comment-indent-function)
155 (setq comment-indent-function 'lisp-comment-indent)
156 (make-local-variable 'parse-sexp-ignore-comments)
157 (setq parse-sexp-ignore-comments t)
158 (make-local-variable 'lisp-indent-function)
159 (set lisp-indent-function 'scheme-indent-function)
160 (setq mode-line-process '("" scheme-mode-line-process))
161 (make-local-variable 'imenu-case-fold-search)
162 (setq imenu-case-fold-search t)
163 (make-local-variable 'imenu-generic-expression)
164 (setq imenu-generic-expression scheme-imenu-generic-expression)
165 (make-local-variable 'imenu-syntax-alist)
166 (setq imenu-syntax-alist '(("+-*/.<>=?!$%_&~^:" . "w")))
167 (make-local-variable 'font-lock-defaults)
168 (setq font-lock-defaults
169 '((scheme-font-lock-keywords
170 scheme-font-lock-keywords-1 scheme-font-lock-keywords-2)
171 nil t (("+-*/.<>=!?$%_&~^:" . "w")) beginning-of-defun
172 (font-lock-mark-block-function . mark-defun))))
174 (defvar scheme-mode-line-process "")
176 (defvar scheme-mode-map nil
177 "Keymap for Scheme mode.
178 All commands in `shared-lisp-mode-map' are inherited by this map.")
182 (let ((map (make-sparse-keymap "Scheme")))
183 (setq scheme-mode-map
184 (nconc (make-sparse-keymap) shared-lisp-mode-map))
185 (define-key scheme-mode-map [menu-bar] (make-sparse-keymap))
186 (define-key scheme-mode-map [menu-bar scheme]
188 (define-key map [run-scheme] '("Run Inferior Scheme" . run-scheme))
189 (define-key map [uncomment-region]
190 '("Uncomment Out Region" . (lambda (beg end)
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)
198 (put 'indent-region 'menu-enable 'mark-active)))
201 (defun scheme-mode-commands (map)
202 ;;(define-key map "\t" 'indent-for-tab-command) ; default
203 (define-key map "\177" 'backward-delete-char-untabify)
204 (define-key map "\e\C-q" 'indent-sexp))
207 (defun scheme-mode ()
208 "Major mode for editing Scheme code.
209 Editing commands are similar to those of lisp-mode.
211 In addition, if an inferior Scheme process is running, some additional
212 commands will be defined, for evaluating expressions and controlling
213 the interpreter, and the state of the process will be displayed in the
214 modeline of all Scheme buffers. The names of commands that interact
215 with the Scheme process start with \"xscheme-\". For more information
216 see the documentation for xscheme-interaction-mode.
219 Delete converts tabs to spaces as it moves back.
220 Blank lines separate paragraphs. Semicolons start comments.
222 Entry to this mode calls the value of scheme-mode-hook
223 if that value is non-nil."
225 (kill-all-local-variables)
226 (scheme-mode-initialize)
227 (scheme-mode-variables)
228 (run-hooks 'scheme-mode-hook))
230 (defun scheme-mode-initialize ()
231 (use-local-map scheme-mode-map)
232 (setq major-mode 'scheme-mode)
233 (setq mode-name "Scheme"))
236 "Editing Scheme code"
239 (defcustom scheme-mit-dialect t
240 "If non-nil, scheme mode is specialized for MIT Scheme.
241 Set this to nil if you normally use another dialect."
245 (defcustom dsssl-sgml-declaration
246 "<!DOCTYPE style-sheet PUBLIC \"-//James Clark//DTD DSSSL Style Sheet//EN\">
248 "*An SGML declaration for the DSSSL file.
249 If it is defined as a string this will be inserted into an empty buffer
250 which is in dsssl-mode. It is typically James Clark's style-sheet
251 doctype, as required for Jade."
252 :type '(choice (string :tag "Specified string")
253 (const :tag "None" :value nil))
256 (defcustom scheme-mode-hook nil
257 "Normal hook (list of functions) run when entering scheme-mode.
262 (defcustom dsssl-mode-hook nil
263 "Normal hook (list of functions) run when entering dsssl-mode.
268 (defvar dsssl-imenu-generic-expression
269 ;; Perhaps this should also look for the style-sheet DTD tags. I'm
270 ;; not sure it's the best way to organize it; perhaps one type
271 ;; should be at the first level, though you don't see this anyhow if
274 "^(define\\s-+(?\\(\\sw+\\)" 1)
276 "^\\s-*(mode\\s-+\\(\\(\\sw\\|\\s-\\)+\\)" 1)
278 ;; (element foo ...) or (element (foo bar ...) ...)
279 ;; Fixme: Perhaps it should do `root'.
280 "^\\s-*(element\\s-+(?\\(\\(\\sw\\|\\s-\\)+\\))?" 1)
282 "^(declare\\(-\\sw+\\)+\\>\\s-+\\(\\sw+\\)" 2))
283 "Imenu generic expression for DSSSL mode. See `imenu-generic-expression'.")
285 (defconst scheme-font-lock-keywords-1
289 ;; Declarations. Hannes Haug <hannes.haug@student.uni-tuebingen.de> says
290 ;; this works for SOS, STklos, SCOOPS, Meroon and Tiny CLOS.
291 (list (concat "(\\(define\\*?\\("
293 "\\(\\|-public\\|-method\\|-generic\\(-procedure\\)?\\)\\|"
294 ;; Macro names, as variable names. A bit dubious, this.
301 ;; Any whitespace and declared object.
304 '(1 font-lock-keyword-face)
305 '(6 (cond ((match-beginning 3) font-lock-function-name-face)
306 ((match-beginning 5) font-lock-variable-name-face)
307 (t font-lock-type-face))
310 "Subdued expressions to highlight in Scheme modes.")
312 (defconst scheme-font-lock-keywords-2
313 (append scheme-font-lock-keywords-1
317 ;; Control structures.
321 '("begin" "call-with-current-continuation" "call/cc"
322 "call-with-input-file" "call-with-output-file" "case" "cond"
323 "do" "else" "for-each" "if" "lambda"
324 "let" "let*" "let-syntax" "letrec" "letrec-syntax"
325 ;; Hannes Haug <hannes.haug@student.uni-tuebingen.de> wants:
327 ;; Stefan Monnier <stefan.monnier@epfl.ch> says don't bother:
328 ;;"quasiquote" "quote" "unquote" "unquote-splicing"
329 "map" "syntax" "syntax-rules") t)
332 ;; David Fox <fox@graphics.cs.nyu.edu> for SOS/STklos class specifiers.
333 '("\\<<\\sw+>\\>" . font-lock-type-face)
335 ;; Scheme `:' keywords as builtins.
336 '("\\<:\\sw+\\>" . font-lock-builtin-face)
338 "Gaudy expressions to highlight in Scheme modes.")
340 (defvar scheme-font-lock-keywords scheme-font-lock-keywords-1
341 "Default expressions to highlight in Scheme modes.")
345 "Major mode for editing DSSSL code.
346 Editing commands are similar to those of lisp-mode.
349 Delete converts tabs to spaces as it moves back.
350 Blank lines separate paragraphs. Semicolons start comments.
352 Entering this mode runs the hooks `scheme-mode-hook' and then
353 `dsssl-mode-hook' and inserts the value of `dsssl-sgml-declaration' if
354 that variable's value is a string."
356 (kill-all-local-variables)
357 (use-local-map scheme-mode-map)
358 (scheme-mode-initialize)
359 (make-local-variable 'page-delimiter)
360 (setq page-delimiter "^;;;" ; ^L not valid SGML char
361 major-mode 'dsssl-mode
363 ;; Insert a suitable SGML declaration into an empty buffer.
364 (and (zerop (buffer-size))
365 (stringp dsssl-sgml-declaration)
366 (not buffer-read-only)
367 (insert dsssl-sgml-declaration))
368 (scheme-mode-variables)
369 (setq font-lock-defaults '(dsssl-font-lock-keywords
370 nil t (("+-*/.<>=?$%_&~^:" . "w"))
372 (font-lock-mark-block-function . mark-defun)))
373 (setq imenu-case-fold-search nil)
374 (setq imenu-generic-expression dsssl-imenu-generic-expression)
375 (setq imenu-syntax-alist '(("+-*/.<>=?$%_&~^:" . "w")))
376 (run-hooks 'scheme-mode-hook)
377 (run-hooks 'dsssl-mode-hook))
379 ;; Extra syntax for DSSSL. This isn't separated from Scheme, but
380 ;; shouldn't cause much trouble in scheme-mode.
381 (put 'element 'scheme-indent-function 1)
382 (put 'mode 'scheme-indent-function 1)
383 (put 'with-mode 'scheme-indent-function 1)
384 (put 'make 'scheme-indent-function 1)
385 (put 'style 'scheme-indent-function 1)
386 (put 'root 'scheme-indent-function 1)
388 (defvar dsssl-font-lock-keywords
392 (list "(\\(define\\(-\\w+\\)?\\)\\>[ ]*\\\((?\\)\\(\\sw+\\)\\>"
393 '(1 font-lock-keyword-face)
394 '(4 font-lock-function-name-face))
397 ;; (make-regexp '("case" "cond" "else" "if" "lambda"
398 ;; "let" "let*" "letrec" "and" "or" "map" "with-mode"))
399 "and\\|c\\(ase\\|ond\\)\\|else\\|if\\|"
400 "l\\(ambda\\|et\\(\\|*\\|rec\\)\\)\\|map\\|or\\|with-mode"
404 '("(\\(element\\|mode\\|declare-\\w+\\)\\>[ ]*\\(\\sw+\\)"
405 (1 font-lock-keyword-face)
406 (2 font-lock-type-face))
407 '("(\\(element\\)\\>[ ]*(\\(\\S)+\\))"
408 (1 font-lock-keyword-face)
409 (2 font-lock-type-face))
410 '("\\<\\sw+:\\>" . font-lock-constant-face) ; trailing `:' c.f. scheme
411 ;; SGML markup (from sgml-mode) :
412 '("<\\([!?][-a-z0-9]+\\)" 1 font-lock-keyword-face)
413 '("<\\(/?[-a-z0-9]+\\)" 1 font-lock-function-name-face)))
414 "Default expressions to highlight in DSSSL mode.")
417 (defvar calculate-lisp-indent-last-sexp)
419 ;; Copied from lisp-indent-function, but with gets of
420 ;; scheme-indent-{function,hook}.
421 (defun scheme-indent-function (indent-point state)
422 (let ((normal-indent (current-column)))
423 (goto-char (1+ (elt state 1)))
424 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
425 (if (and (elt state 2)
426 (not (looking-at "\\sw\\|\\s_")))
427 ;; car of form doesn't seem to be a a symbol
429 (if (not (> (save-excursion (forward-line 1) (point))
430 calculate-lisp-indent-last-sexp))
431 (progn (goto-char calculate-lisp-indent-last-sexp)
433 (parse-partial-sexp (point)
434 calculate-lisp-indent-last-sexp 0 t)))
435 ;; Indent under the list or under the first sexp on the same
436 ;; line as calculate-lisp-indent-last-sexp. Note that first
437 ;; thing on that line has to be complete sexp since we are
438 ;; inside the innermost containing sexp.
439 (backward-prefix-chars)
441 (let ((function (buffer-substring (point)
442 (progn (forward-sexp 1) (point))))
444 (setq method (or (get (intern-soft function) 'scheme-indent-function)
445 (get (intern-soft function) 'scheme-indent-hook)))
446 (cond ((or (eq method 'defun)
448 (> (length function) 3)
449 (string-match "\\`def" function)))
450 (lisp-indent-defform state indent-point))
452 (lisp-indent-specform method state
453 indent-point normal-indent))
455 (funcall method state indent-point normal-indent)))))))
458 ;;; Let is different in Scheme
460 (defun would-be-symbol (string)
461 (not (string-equal (substring string 0 1) "(")))
463 (defun next-sexp-as-string ()
464 ;; Assumes that protected by a save-excursion
466 (let ((the-end (point)))
468 (buffer-substring (point) the-end)))
470 ;; This is correct but too slow.
471 ;; The one below works almost always.
472 ;;(defun scheme-let-indent (state indent-point)
473 ;; (if (would-be-symbol (next-sexp-as-string))
474 ;; (scheme-indent-specform 2 state indent-point)
475 ;; (scheme-indent-specform 1 state indent-point)))
477 (defun scheme-let-indent (state indent-point normal-indent)
478 (skip-chars-forward " \t")
479 (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]")
480 (lisp-indent-specform 2 state indent-point normal-indent)
481 (lisp-indent-specform 1 state indent-point normal-indent)))
483 ;; (put 'begin 'scheme-indent-function 0), say, causes begin to be indented
484 ;; like defun if the first form is placed on the next line, otherwise
485 ;; it is indented like any other form (i.e. forms line up under first).
487 (put 'begin 'scheme-indent-function 0)
488 (put 'case 'scheme-indent-function 1)
489 (put 'delay 'scheme-indent-function 0)
490 (put 'do 'scheme-indent-function 2)
491 (put 'lambda 'scheme-indent-function 1)
492 (put 'let 'scheme-indent-function 'scheme-let-indent)
493 (put 'let* 'scheme-indent-function 1)
494 (put 'letrec 'scheme-indent-function 1)
495 (put 'sequence 'scheme-indent-function 0) ; SICP, not r4rs
496 (put 'let-syntax 'scheme-indent-function 1)
497 (put 'letrec-syntax 'scheme-indent-function 1)
498 (put 'syntax-rules 'scheme-indent-function 1)
501 (put 'call-with-input-file 'scheme-indent-function 1)
502 (put 'with-input-from-file 'scheme-indent-function 1)
503 (put 'with-input-from-port 'scheme-indent-function 1)
504 (put 'call-with-output-file 'scheme-indent-function 1)
505 (put 'with-output-to-file 'scheme-indent-function 1)
506 (put 'with-output-to-port 'scheme-indent-function 1)
507 (put 'call-with-values 'scheme-indent-function 1) ; r5rs?
508 (put 'dynamic-wind 'scheme-indent-function 3) ; r5rs?
510 ;;;; MIT Scheme specific indentation.
512 (if scheme-mit-dialect
514 (put 'fluid-let 'scheme-indent-function 1)
515 (put 'in-package 'scheme-indent-function 1)
516 (put 'local-declare 'scheme-indent-function 1)
517 (put 'macro 'scheme-indent-function 1)
518 (put 'make-environment 'scheme-indent-function 0)
519 (put 'named-lambda 'scheme-indent-function 1)
520 (put 'using-syntax 'scheme-indent-function 1)
522 (put 'with-input-from-string 'scheme-indent-function 1)
523 (put 'with-output-to-string 'scheme-indent-function 0)
524 (put 'with-values 'scheme-indent-function 1)
526 (put 'syntax-table-define 'scheme-indent-function 2)
527 (put 'list-transform-positive 'scheme-indent-function 1)
528 (put 'list-transform-negative 'scheme-indent-function 1)
529 (put 'list-search-positive 'scheme-indent-function 1)
530 (put 'list-search-negative 'scheme-indent-function 1)
532 (put 'access-components 'scheme-indent-function 1)
533 (put 'assignment-components 'scheme-indent-function 1)
534 (put 'combination-components 'scheme-indent-function 1)
535 (put 'comment-components 'scheme-indent-function 1)
536 (put 'conditional-components 'scheme-indent-function 1)
537 (put 'disjunction-components 'scheme-indent-function 1)
538 (put 'declaration-components 'scheme-indent-function 1)
539 (put 'definition-components 'scheme-indent-function 1)
540 (put 'delay-components 'scheme-indent-function 1)
541 (put 'in-package-components 'scheme-indent-function 1)
542 (put 'lambda-components 'scheme-indent-function 1)
543 (put 'lambda-components* 'scheme-indent-function 1)
544 (put 'lambda-components** 'scheme-indent-function 1)
545 (put 'open-block-components 'scheme-indent-function 1)
546 (put 'pathname-components 'scheme-indent-function 1)
547 (put 'procedure-components 'scheme-indent-function 1)
548 (put 'sequence-components 'scheme-indent-function 1)
549 (put 'unassigned\?-components 'scheme-indent-function 1)
550 (put 'unbound\?-components 'scheme-indent-function 1)
551 (put 'variable-components 'scheme-indent-function 1)))
555 ;;; scheme.el ends here