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