lisp/progmodes/scheme.el

   1 ;;; scheme.el --- Scheme (and DSSSL) editing mode.
   2
   3 ;; Copyright (C) 1986, 87, 88, 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: Bill Rozas <jinx@martigny.ai.mit.edu>
   6 ;; Keywords: languages, lisp
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;; Originally adapted from Lisp mode by Bill Rozas, jinx@prep with a
  26 ;; comment that the code should be merged back.  Merging done by
  27 ;; d.love@dl.ac.uk when DSSSL features added.
  28
  29 ;;; Commentary:
  30
  31 ;; The major mode for editing Scheme-type Lisp code, very similar to
  32 ;; the Lisp mode documented in the Emacs manual.  `dsssl-mode' is a
  33 ;; variant of scheme-mode for editing DSSSL specifications for SGML
  34 ;; documents.  [As of Apr 1997, some pointers for DSSSL may be found,
  35 ;; for instance, at <URL:http://www.sil.org/sgml/related.html#dsssl>.]
  36 ;; All these Lisp-ish modes vary basically in details of the language
  37 ;; syntax they highlight/indent/index, but dsssl-mode uses "^;;;" as
  38 ;; the page-delimiter since ^L isn't normally a legal SGML character.
  39 ;;
  40 ;; For interacting with a Scheme interpreter See also `run-scheme' in
  41 ;; the `cmuscheme' package and also the implementation-specific
  42 ;; `xscheme' package.
  43
  44 ;;; Code:
  45 \f
  46 (require 'lisp-mode)
  47
  48 (defvar scheme-mode-syntax-table nil "")
  49 (if (not scheme-mode-syntax-table)
  50     (let ((i 0))
  51       (setq scheme-mode-syntax-table (make-syntax-table))
  52       (set-syntax-table scheme-mode-syntax-table)
  53
  54       ;; Default is atom-constituent.
  55       (while (< i 256)
  56         (modify-syntax-entry i "_   ")
  57         (setq i (1+ i)))
  58
  59       ;; Word components.
  60       (setq i ?0)
  61       (while (<= i ?9)
  62         (modify-syntax-entry i "w   ")
  63         (setq i (1+ i)))
  64       (setq i ?A)
  65       (while (<= i ?Z)
  66         (modify-syntax-entry i "w   ")
  67         (setq i (1+ i)))
  68       (setq i ?a)
  69       (while (<= i ?z)
  70         (modify-syntax-entry i "w   ")
  71         (setq i (1+ i)))
  72
  73       ;; Whitespace
  74       (modify-syntax-entry ?\t "    ")
  75       (modify-syntax-entry ?\n ">   ")
  76       (modify-syntax-entry ?\f "    ")
  77       (modify-syntax-entry ?\r "    ")
  78       (modify-syntax-entry ?  "    ")
  79
  80       ;; These characters are delimiters but otherwise undefined.
  81       ;; Brackets and braces balance for editing convenience.
  82       (modify-syntax-entry ?\[ "(]  ")
  83       (modify-syntax-entry ?\] ")[  ")
  84       (modify-syntax-entry ?{ "(}  ")
  85       (modify-syntax-entry ?} "){  ")
  86       (modify-syntax-entry ?\| "  23")
  87
  88       ;; Other atom delimiters
  89       (modify-syntax-entry ?\( "()  ")
  90       (modify-syntax-entry ?\) ")(  ")
  91       (modify-syntax-entry ?\; "<   ")
  92       (modify-syntax-entry ?\" "\"    ")
  93       (modify-syntax-entry ?' "  p")
  94       (modify-syntax-entry ?` "  p")
  95
  96       ;; Special characters
  97       (modify-syntax-entry ?, "_ p")
  98       (modify-syntax-entry ?@ "_ p")
  99       (modify-syntax-entry ?# "_ p14")
 100       (modify-syntax-entry ?\\ "\\   ")))
 101 \f
 102 (defvar scheme-mode-abbrev-table nil "")
 103 (define-abbrev-table 'scheme-mode-abbrev-table ())
 104
 105 (defvar scheme-imenu-generic-expression
 106       '((nil
 107          "^(define\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)*\\s-+(?\\(\\(\\sw\\|\\s_\\)+\\)" 4)
 108         (" Types"
 109          "^(define-class\\s-+(?\\(\\(\\sw\\|\\s_\\)+\\)" 1)
 110         (" Macros"
 111          "^(\\(defmacro\\|define-macro\\|define-syntax\\)\\s-+(?\\(\\(\\sw\\|\\s_\\)+\\)" 2))
 112   "Imenu generic expression for Scheme mode.  See `imenu-generic-expression'.")
 113
 114 (defun scheme-mode-variables ()
 115   (set-syntax-table scheme-mode-syntax-table)
 116   (setq local-abbrev-table scheme-mode-abbrev-table)
 117   (make-local-variable 'paragraph-start)
 118   (setq paragraph-start (concat "$\\|" page-delimiter))
 119   (make-local-variable 'paragraph-separate)
 120   (setq paragraph-separate paragraph-start)
 121   (make-local-variable 'paragraph-ignore-fill-prefix)
 122   (setq paragraph-ignore-fill-prefix t)
 123   (make-local-variable 'fill-paragraph-function)
 124   (setq fill-paragraph-function 'lisp-fill-paragraph)
 125   ;; Adaptive fill mode gets in the way of auto-fill,
 126   ;; and should make no difference for explicit fill
 127   ;; because lisp-fill-paragraph should do the job.
 128   (make-local-variable 'adaptive-fill-mode)
 129   (setq adaptive-fill-mode nil)
 130   (make-local-variable 'indent-line-function)
 131   (setq indent-line-function 'lisp-indent-line)
 132   (make-local-variable 'parse-sexp-ignore-comments)
 133   (setq parse-sexp-ignore-comments t)
 134   (make-local-variable 'outline-regexp)
 135   (setq outline-regexp ";;; \\|(....")
 136   (make-local-variable 'comment-start)
 137   (setq comment-start ";")
 138   (make-local-variable 'comment-start-skip)
 139   ;; Look within the line for a ; following an even number of backslashes
 140   ;; after either a non-backslash or the line beginning.
 141   (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
 142   (make-local-variable 'comment-column)
 143   (setq comment-column 40)
 144   (make-local-variable 'comment-indent-function)
 145   (setq comment-indent-function 'lisp-comment-indent)
 146   (make-local-variable 'parse-sexp-ignore-comments)
 147   (setq parse-sexp-ignore-comments t)
 148   (make-local-variable 'lisp-indent-function)
 149   (set lisp-indent-function 'scheme-indent-function)
 150   (setq mode-line-process '("" scheme-mode-line-process))
 151   (make-local-variable 'imenu-generic-expression)
 152   (setq imenu-generic-expression scheme-imenu-generic-expression))
 153
 154 (defvar scheme-mode-line-process "")
 155
 156 (defvar scheme-mode-map nil
 157   "Keymap for Scheme mode.
 158 All commands in `shared-lisp-mode-map' are inherited by this map.")
 159
 160 (if scheme-mode-map
 161     ()
 162   (let ((map (make-sparse-keymap "Scheme")))
 163     (setq scheme-mode-map
 164           (nconc (make-sparse-keymap) shared-lisp-mode-map))
 165     (define-key scheme-mode-map "\e\t" 'lisp-complete-symbol)
 166     (define-key scheme-mode-map [menu-bar] (make-sparse-keymap))
 167     (define-key scheme-mode-map [menu-bar scheme]
 168       (cons "Scheme" map))
 169     (define-key map [run-scheme] '("Run Inferior Scheme" . run-scheme))
 170     (define-key map [comment-region] '("Comment Out Region" . comment-region))
 171     (define-key map [indent-region] '("Indent Region" . indent-region))
 172     (define-key map [indent-line] '("Indent Line" . lisp-indent-line))
 173     (put 'comment-region 'menu-enable 'mark-active)
 174     (put 'indent-region 'menu-enable 'mark-active)))
 175
 176 ;; Used by cmuscheme
 177 (defun scheme-mode-commands (map)
 178   ;;(define-key map "\t" 'indent-for-tab-command) ; default
 179   (define-key map "\177" 'backward-delete-char-untabify)
 180   (define-key map "\e\C-q" 'indent-sexp))
 181 \f
 182 ;;;###autoload
 183 (defun scheme-mode ()
 184   "Major mode for editing Scheme code.
 185 Editing commands are similar to those of lisp-mode.
 186
 187 In addition, if an inferior Scheme process is running, some additional
 188 commands will be defined, for evaluating expressions and controlling
 189 the interpreter, and the state of the process will be displayed in the
 190 modeline of all Scheme buffers.  The names of commands that interact
 191 with the Scheme process start with \"xscheme-\".  For more information
 192 see the documentation for xscheme-interaction-mode.
 193
 194 Commands:
 195 Delete converts tabs to spaces as it moves back.
 196 Blank lines separate paragraphs.  Semicolons start comments.
 197 \\{scheme-mode-map}
 198 Entry to this mode calls the value of scheme-mode-hook
 199 if that value is non-nil."
 200   (interactive)
 201   (kill-all-local-variables)
 202   (scheme-mode-initialize)
 203   (scheme-mode-variables)
 204   (run-hooks 'scheme-mode-hook))
 205
 206 (defun scheme-mode-initialize ()
 207   (use-local-map scheme-mode-map)
 208   (setq major-mode 'scheme-mode)
 209   (setq mode-name "Scheme"))
 210
 211 (defgroup scheme nil
 212   "Editing Scheme code"
 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 This will be inserted into an empty buffer in dsssl-mode if it is
 226 defined as a string.  It is typically James Clark's style-sheet
 227 doctype, as required for Jade."
 228   :group 'scheme)
 229
 230 (defvar dsssl-imenu-generic-expression
 231   ;; Perhaps this should also look for the style-sheet DTD tags.  I'm
 232   ;; not sure it's the best way to organize it; perhaps one type
 233   ;; should be at the first level, though you don't see this anyhow if
 234   ;; it gets split up.
 235   '((" Defines"
 236      "^(define\\s-+(?\\(\\(\\sw\\|\\s_\\)+\\)" 1)
 237     (" Modes"
 238      "^\\s-*(mode\\s-+\\(\\(\\sw\\|\\s-\\|\\s_\\)+\\)" 1)
 239     (" Elements"
 240      ;; (element foo ...) or (element (foo bar ...) ...)
 241      ;; Fixme: Perhaps it should do `root'.
 242      "^\\s-*(element\\s-+(?\\(\\(\\sw\\|\\s-\\|\\s_\\)+\\))?" 1)
 243     (" Declarations"
 244      "^(declare\\(-\\sw+\\)+\\>\\s-+\\(\\(\\sw\\|\\s_\\)+\\)" 2))
 245   "Imenu generic expression for DSSSL mode.  See `imenu-generic-expression'.")
 246
 247 ;;;###autoload
 248 (defun dsssl-mode ()
 249   "Major mode for editing DSSSL code.
 250 Editing commands are similar to those of lisp-mode.
 251
 252 Commands:
 253 Delete converts tabs to spaces as it moves back.
 254 Blank lines separate paragraphs.  Semicolons start comments.
 255 \\{scheme-mode-map}
 256 Entry to this mode calls the value of dsssl-mode-hook
 257 if that value is non-nil and inserts the value of
 258 `dsssl-sgml-declaration' if that variable's value is a string."
 259   (interactive)
 260   (kill-all-local-variables)
 261   (use-local-map scheme-mode-map)
 262   (scheme-mode-initialize)
 263   (make-local-variable 'font-lock-defaults)
 264   (setq font-lock-defaults '(dsssl-font-lock-keywords
 265                              nil t (("+-*/.<>=!?$%_&~^:" . "w"))
 266                              beginning-of-defun
 267                              (font-lock-comment-start-regexp . ";")
 268                              (font-lock-mark-block-function . mark-defun)))
 269   (make-local-variable 'page-delimiter)
 270   (setq page-delimiter "^;;;" ; ^L not valid SGML char
 271         major-mode 'dsssl-mode
 272         mode-name "DSSSL")
 273   ;; Insert a suitable SGML declaration into an empty buffer.
 274   (and (zerop (buffer-size))
 275        (stringp dsssl-sgml-declaration)
 276        (not buffer-read-only)
 277        (insert dsssl-sgml-declaration))
 278   (run-hooks 'scheme-mode-hook)
 279   (run-hooks 'dsssl-mode-hook)
 280   (scheme-mode-variables)
 281   (setq imenu-generic-expression dsssl-imenu-generic-expression))
 282
 283 ;; Extra syntax for DSSSL.  This isn't separated from Scheme, but
 284 ;; shouldn't cause much trouble in scheme-mode.
 285 (put 'element 'scheme-indent-function 1)
 286 (put 'mode 'scheme-indent-function 1)
 287 (put 'with-mode 'scheme-indent-function 1)
 288 (put 'make 'scheme-indent-function 1)
 289 (put 'style 'scheme-indent-function 1)
 290 (put 'root 'scheme-indent-function 1)
 291
 292 (defvar dsssl-font-lock-keywords
 293   (eval-when-compile
 294     (list
 295      ;; Similar to Scheme
 296      (list "(\\(define\\(-\\w+\\)?\\)\\>[       ]*\\\((?\\)\\(\\sw+\\)\\>"
 297            '(1 font-lock-keyword-face)
 298            '(4 font-lock-function-name-face))
 299      (cons
 300       (concat "(\\("
 301               ;; (make-regexp '("case" "cond" "else" "if" "lambda"
 302               ;; "let" "let*" "letrec" "and" "or" "map" "with-mode"))
 303               "and\\|c\\(ase\\|ond\\)\\|else\\|if\\|"
 304               "l\\(ambda\\|et\\(\\|*\\|rec\\)\\)\\|map\\|or\\|with-mode"
 305               "\\)\\>")
 306       1)
 307      ;; DSSSL syntax
 308      '("(\\(element\\|mode\\|declare-\\w+\\)\\>[        ]*\\(\\sw+\\)"
 309        (1 font-lock-keyword-face)
 310        (2 font-lock-type-face))
 311      '("(\\(element\\)\\>[      ]*(\\(\\S)+\\))"
 312        (1 font-lock-keyword-face)
 313        (2 font-lock-type-face))
 314      '("\\<\\sw+:\\>" . font-lock-reference-face) ; trailing `:' c.f. scheme
 315      ;; SGML markup (from sgml-mode) :
 316      '("<\\([!?][-a-z0-9]+\\)" 1 font-lock-keyword-face)
 317      '("<\\(/?[-a-z0-9]+\\)" 1 font-lock-function-name-face)))
 318   "Default expressions to highlight in DSSSL mode.")
 319
 320 \f
 321 (defvar calculate-lisp-indent-last-sexp)
 322
 323 ;; Copied from lisp-indent-function, but with gets of
 324 ;; scheme-indent-{function,hook}.
 325 (defun scheme-indent-function (indent-point state)
 326   (let ((normal-indent (current-column)))
 327     (goto-char (1+ (elt state 1)))
 328     (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
 329     (if (and (elt state 2)
 330              (not (looking-at "\\sw\\|\\s_")))
 331         ;; car of form doesn't seem to be a a symbol
 332         (progn
 333           (if (not (> (save-excursion (forward-line 1) (point))
 334                       calculate-lisp-indent-last-sexp))
 335               (progn (goto-char calculate-lisp-indent-last-sexp)
 336                      (beginning-of-line)
 337                      (parse-partial-sexp (point)
 338                                          calculate-lisp-indent-last-sexp 0 t)))
 339           ;; Indent under the list or under the first sexp on the same
 340           ;; line as calculate-lisp-indent-last-sexp.  Note that first
 341           ;; thing on that line has to be complete sexp since we are
 342           ;; inside the innermost containing sexp.
 343           (backward-prefix-chars)
 344           (current-column))
 345       (let ((function (buffer-substring (point)
 346                                         (progn (forward-sexp 1) (point))))
 347             method)
 348         (setq method (or (get (intern-soft function) 'scheme-indent-function)
 349                          (get (intern-soft function) 'scheme-indent-hook)))
 350         (cond ((or (eq method 'defun)
 351                    (and (null method)
 352                         (> (length function) 3)
 353                         (string-match "\\`def" function)))
 354                (lisp-indent-defform state indent-point))
 355               ((integerp method)
 356                (lisp-indent-specform method state
 357                                      indent-point normal-indent))
 358               (method
 359                 (funcall method state indent-point)))))))
 360
 361 \f
 362 ;;; Let is different in Scheme
 363
 364 (defun would-be-symbol (string)
 365   (not (string-equal (substring string 0 1) "(")))
 366
 367 (defun next-sexp-as-string ()
 368   ;; Assumes that protected by a save-excursion
 369   (forward-sexp 1)
 370   (let ((the-end (point)))
 371     (backward-sexp 1)
 372     (buffer-substring (point) the-end)))
 373
 374 ;; This is correct but too slow.
 375 ;; The one below works almost always.
 376 ;;(defun scheme-let-indent (state indent-point)
 377 ;;  (if (would-be-symbol (next-sexp-as-string))
 378 ;;      (scheme-indent-specform 2 state indent-point)
 379 ;;      (scheme-indent-specform 1 state indent-point)))
 380
 381 (defun scheme-let-indent (state indent-point)
 382   (skip-chars-forward " \t")
 383   (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]")
 384       (lisp-indent-specform 2 state indent-point (current-column))
 385       (lisp-indent-specform 1 state indent-point (current-column))))
 386
 387 ;; (put 'begin 'scheme-indent-function 0), say, causes begin to be indented
 388 ;; like defun if the first form is placed on the next line, otherwise
 389 ;; it is indented like any other form (i.e. forms line up under first).
 390
 391 (put 'begin 'scheme-indent-function 0)
 392 (put 'case 'scheme-indent-function 1)
 393 (put 'delay 'scheme-indent-function 0)
 394 (put 'do 'scheme-indent-function 2)
 395 (put 'lambda 'scheme-indent-function 1)
 396 (put 'let 'scheme-indent-function 'scheme-let-indent)
 397 (put 'let* 'scheme-indent-function 1)
 398 (put 'letrec 'scheme-indent-function 1)
 399 (put 'sequence 'scheme-indent-function 0)
 400
 401 (put 'call-with-input-file 'scheme-indent-function 1)
 402 (put 'with-input-from-file 'scheme-indent-function 1)
 403 (put 'with-input-from-port 'scheme-indent-function 1)
 404 (put 'call-with-output-file 'scheme-indent-function 1)
 405 (put 'with-output-to-file 'scheme-indent-function 1)
 406 (put 'with-output-to-port 'scheme-indent-function 1)
 407 \f
 408 ;;;; MIT Scheme specific indentation.
 409
 410 (if scheme-mit-dialect
 411     (progn
 412       (put 'fluid-let 'scheme-indent-function 1)
 413       (put 'in-package 'scheme-indent-function 1)
 414       (put 'let-syntax 'scheme-indent-function 1)
 415       (put 'local-declare 'scheme-indent-function 1)
 416       (put 'macro 'scheme-indent-function 1)
 417       (put 'make-environment 'scheme-indent-function 0)
 418       (put 'named-lambda 'scheme-indent-function 1)
 419       (put 'using-syntax 'scheme-indent-function 1)
 420
 421       (put 'with-input-from-string 'scheme-indent-function 1)
 422       (put 'with-output-to-string 'scheme-indent-function 0)
 423       (put 'with-values 'scheme-indent-function 1)
 424
 425       (put 'syntax-table-define 'scheme-indent-function 2)
 426       (put 'list-transform-positive 'scheme-indent-function 1)
 427       (put 'list-transform-negative 'scheme-indent-function 1)
 428       (put 'list-search-positive 'scheme-indent-function 1)
 429       (put 'list-search-negative 'scheme-indent-function 1)
 430
 431       (put 'access-components 'scheme-indent-function 1)
 432       (put 'assignment-components 'scheme-indent-function 1)
 433       (put 'combination-components 'scheme-indent-function 1)
 434       (put 'comment-components 'scheme-indent-function 1)
 435       (put 'conditional-components 'scheme-indent-function 1)
 436       (put 'disjunction-components 'scheme-indent-function 1)
 437       (put 'declaration-components 'scheme-indent-function 1)
 438       (put 'definition-components 'scheme-indent-function 1)
 439       (put 'delay-components 'scheme-indent-function 1)
 440       (put 'in-package-components 'scheme-indent-function 1)
 441       (put 'lambda-components 'scheme-indent-function 1)
 442       (put 'lambda-components* 'scheme-indent-function 1)
 443       (put 'lambda-components** 'scheme-indent-function 1)
 444       (put 'open-block-components 'scheme-indent-function 1)
 445       (put 'pathname-components 'scheme-indent-function 1)
 446       (put 'procedure-components 'scheme-indent-function 1)
 447       (put 'sequence-components 'scheme-indent-function 1)
 448       (put 'unassigned\?-components 'scheme-indent-function 1)
 449       (put 'unbound\?-components 'scheme-indent-function 1)
 450       (put 'variable-components 'scheme-indent-function 1)))
 451
 452 (provide 'scheme)
 453
 454 ;;; scheme.el ends here