lisp/progmodes/scheme.el

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