lisp/progmodes/scheme.el

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