lisp/progmodes/scheme.el

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