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 <jinz@prep.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" 'scheme-indent-line)
 179   (define-key map "\177" 'backward-delete-char-untabify)
 180   (define-key map "\e\C-q" 'scheme-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 (defvar scheme-mit-dialect t
 212   "If non-nil, scheme mode is specialized for MIT Scheme.
 213 Set this to nil if you normally use another dialect.")
 214
 215 (defvar dsssl-sgml-declaration
 216   "<!DOCTYPE style-sheet PUBLIC \"-//James Clark//DTD DSSSL Style Sheet//EN\">
 217 "
 218   "*An SGML declaration (typically using James Clark's style-sheet
 219 doctype, as required for Jade) which will be inserted into an empty
 220 buffer in dsssl-mode.")
 221
 222 (defvar dsssl-imenu-generic-expression
 223   ;; Perhaps this should also look for the style-sheet DTD tags.  I'm
 224   ;; not sure it's the best way to organize it; perhaps one type
 225   ;; should be at the first level, though you don't see this anyhow if
 226   ;; it gets split up.
 227   '((" Defines"
 228      "^(define\\s-+(?\\(\\(\\sw\\|\\s_\\)+\\)" 1)
 229     (" Modes"
 230      "^\\s-*(mode\\s-+\\(\\(\\sw\\|\\s-\\|\\s_\\)+\\)" 1)
 231     (" Elements"
 232      ;; (element foo ...) or (element (foo bar ...) ...)
 233      "^\\s-*(element\\s-+(?\\(\\(\\sw\\|\\s-\\|\\s_\\)+\\))?" 1)
 234     (" Declarations"
 235      "^(declare\\(-\\sw+\\)+\\>\\s-+\\(\\(\\sw\\|\\s_\\)+\\)" 2))
 236   "Imenu generic expression for DSSSL mode.  See `imenu-generic-expression'.")
 237
 238 ;;;###autoload
 239 (defun dsssl-mode ()
 240   "Major mode for editing DSSSL code.
 241 Editing commands are similar to those of lisp-mode.
 242
 243 Commands:
 244 Delete converts tabs to spaces as it moves back.
 245 Blank lines separate paragraphs.  Semicolons start comments.
 246 \\{scheme-mode-map}
 247 Entry to this mode calls the value of dsssl-mode-hook
 248 if that value is non-nil."
 249   (interactive)
 250   (kill-all-local-variables)
 251   (use-local-map scheme-mode-map)
 252   (scheme-mode-initialize)
 253   (make-local-variable 'font-lock-defaults)
 254   (setq font-lock-defaults '(dsssl-font-lock-keywords
 255                              nil t (("+-*/.<>=!?$%_&~^:" . "w"))
 256                              beginning-of-defun
 257                              (font-lock-comment-start-regexp . ";")
 258                              (font-lock-mark-block-function . mark-defun)))
 259   (make-local-variable 'page-delimiter)
 260   (setq page-delimiter "^;;;" ; ^L not valid SGML char
 261         major-mode 'dsssl-mode
 262         mode-name "DSSSL")
 263   ;; Insert a suitable SGML declaration into an empty buffer.
 264   (and (zerop (buffer-size))
 265        dsssl-sgml-declaration
 266        (not buffer-read-only)
 267        (insert dsssl-sgml-declaration))
 268   (run-hooks 'scheme-mode-hook)
 269   (run-hooks 'dsssl-mode-hook)
 270   (scheme-mode-variables)
 271   (setq imenu-generic-expression dsssl-imenu-generic-expression))
 272
 273 ;; Extra syntax for DSSSL.  This isn't separated from Scheme, but
 274 ;; shouldn't cause much trouble in scheme-mode.
 275 (put 'element 'scheme-indent-function 1)
 276 (put 'mode 'scheme-indent-function 1)
 277 (put 'with-mode 'scheme-indent-function 1)
 278
 279 (defvar dsssl-font-lock-keywords
 280   '(("(\\(define\\(-\\w+\\)?\\)\\>[     ]*\\\((?\\)\\(\\sw+\\)\\>"
 281      (1 font-lock-keyword-face)
 282      (4 font-lock-function-name-face))
 283     ("(\\(case\\|cond\\|else\\|if\\|lambda\\|let\\*?\\|letrec\\|and\\|or\\|map\\|with-mode\\)\\>" . 1)
 284     ("(\\(element\\|mode\\|declare-\\w+\\)\\>[  ]*\\(\\sw+\\)"
 285      (1 font-lock-keyword-face)
 286      (2 font-lock-type-face))
 287     ("(\\(element\\)\\>[        ]*(\\(\\S)+\\))"
 288      (1 font-lock-keyword-face)
 289      (2 font-lock-type-face))
 290     ("\\<\\sw+:\\>" . font-lock-reference-face)
 291     ("<\\([!?][-a-z0-9]+\\)" 1 font-lock-keyword-face)
 292     ("<\\(/?[-a-z0-9]+\\)" 1 font-lock-function-name-face))
 293   "Default expressions to highlight in DSSSL mode.")
 294
 295 \f
 296 (defvar calculate-lisp-indent-last-sexp)
 297
 298 ;; Copied from lisp-indent-function, but with gets of
 299 ;; scheme-indent-{function,hook}.
 300 (defun scheme-indent-function (indent-point state)
 301   (let ((normal-indent (current-column)))
 302     (goto-char (1+ (elt state 1)))
 303     (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
 304     (if (and (elt state 2)
 305              (not (looking-at "\\sw\\|\\s_")))
 306         ;; car of form doesn't seem to be a a symbol
 307         (progn
 308           (if (not (> (save-excursion (forward-line 1) (point))
 309                       calculate-lisp-indent-last-sexp))
 310               (progn (goto-char calculate-lisp-indent-last-sexp)
 311                      (beginning-of-line)
 312                      (parse-partial-sexp (point)
 313                                          calculate-lisp-indent-last-sexp 0 t)))
 314           ;; Indent under the list or under the first sexp on the same
 315           ;; line as calculate-lisp-indent-last-sexp.  Note that first
 316           ;; thing on that line has to be complete sexp since we are
 317           ;; inside the innermost containing sexp.
 318           (backward-prefix-chars)
 319           (current-column))
 320       (let ((function (buffer-substring (point)
 321                                         (progn (forward-sexp 1) (point))))
 322             method)
 323         (setq method (or (get (intern-soft function) 'scheme-indent-function)
 324                          (get (intern-soft function) 'scheme-indent-hook)))
 325         (cond ((or (eq method 'defun)
 326                    (and (null method)
 327                         (> (length function) 3)
 328                         (string-match "\\`def" function)))
 329                (lisp-indent-defform state indent-point))
 330               ((integerp method)
 331                (lisp-indent-specform method state
 332                                      indent-point normal-indent))
 333               (method
 334                 (funcall method state indent-point)))))))
 335
 336 \f
 337 ;;; Let is different in Scheme
 338
 339 (defun would-be-symbol (string)
 340   (not (string-equal (substring string 0 1) "(")))
 341
 342 (defun next-sexp-as-string ()
 343   ;; Assumes that protected by a save-excursion
 344   (forward-sexp 1)
 345   (let ((the-end (point)))
 346     (backward-sexp 1)
 347     (buffer-substring (point) the-end)))
 348
 349 ;; This is correct but too slow.
 350 ;; The one below works almost always.
 351 ;;(defun scheme-let-indent (state indent-point)
 352 ;;  (if (would-be-symbol (next-sexp-as-string))
 353 ;;      (scheme-indent-specform 2 state indent-point)
 354 ;;      (scheme-indent-specform 1 state indent-point)))
 355
 356 (defun scheme-let-indent (state indent-point)
 357   (skip-chars-forward " \t")
 358   (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]")
 359       (lisp-indent-specform 2 state indent-point (current-column))
 360       (lisp-indent-specform 1 state indent-point (current-column))))
 361
 362 ;; (put 'begin 'scheme-indent-function 0), say, causes begin to be indented
 363 ;; like defun if the first form is placed on the next line, otherwise
 364 ;; it is indented like any other form (i.e. forms line up under first).
 365
 366 (put 'begin 'scheme-indent-function 0)
 367 (put 'case 'scheme-indent-function 1)
 368 (put 'delay 'scheme-indent-function 0)
 369 (put 'do 'scheme-indent-function 2)
 370 (put 'lambda 'scheme-indent-function 1)
 371 (put 'let 'scheme-indent-function 'scheme-let-indent)
 372 (put 'let* 'scheme-indent-function 1)
 373 (put 'letrec 'scheme-indent-function 1)
 374 (put 'sequence 'scheme-indent-function 0)
 375
 376 (put 'call-with-input-file 'scheme-indent-function 1)
 377 (put 'with-input-from-file 'scheme-indent-function 1)
 378 (put 'with-input-from-port 'scheme-indent-function 1)
 379 (put 'call-with-output-file 'scheme-indent-function 1)
 380 (put 'with-output-to-file 'scheme-indent-function 1)
 381 (put 'with-output-to-port 'scheme-indent-function 1)
 382 \f
 383 ;;;; MIT Scheme specific indentation.
 384
 385 (if scheme-mit-dialect
 386     (progn
 387       (put 'fluid-let 'scheme-indent-function 1)
 388       (put 'in-package 'scheme-indent-function 1)
 389       (put 'let-syntax 'scheme-indent-function 1)
 390       (put 'local-declare 'scheme-indent-function 1)
 391       (put 'macro 'scheme-indent-function 1)
 392       (put 'make-environment 'scheme-indent-function 0)
 393       (put 'named-lambda 'scheme-indent-function 1)
 394       (put 'using-syntax 'scheme-indent-function 1)
 395
 396       (put 'with-input-from-string 'scheme-indent-function 1)
 397       (put 'with-output-to-string 'scheme-indent-function 0)
 398       (put 'with-values 'scheme-indent-function 1)
 399
 400       (put 'syntax-table-define 'scheme-indent-function 2)
 401       (put 'list-transform-positive 'scheme-indent-function 1)
 402       (put 'list-transform-negative 'scheme-indent-function 1)
 403       (put 'list-search-positive 'scheme-indent-function 1)
 404       (put 'list-search-negative 'scheme-indent-function 1)
 405
 406       (put 'access-components 'scheme-indent-function 1)
 407       (put 'assignment-components 'scheme-indent-function 1)
 408       (put 'combination-components 'scheme-indent-function 1)
 409       (put 'comment-components 'scheme-indent-function 1)
 410       (put 'conditional-components 'scheme-indent-function 1)
 411       (put 'disjunction-components 'scheme-indent-function 1)
 412       (put 'declaration-components 'scheme-indent-function 1)
 413       (put 'definition-components 'scheme-indent-function 1)
 414       (put 'delay-components 'scheme-indent-function 1)
 415       (put 'in-package-components 'scheme-indent-function 1)
 416       (put 'lambda-components 'scheme-indent-function 1)
 417       (put 'lambda-components* 'scheme-indent-function 1)
 418       (put 'lambda-components** 'scheme-indent-function 1)
 419       (put 'open-block-components 'scheme-indent-function 1)
 420       (put 'pathname-components 'scheme-indent-function 1)
 421       (put 'procedure-components 'scheme-indent-function 1)
 422       (put 'sequence-components 'scheme-indent-function 1)
 423       (put 'unassigned\?-components 'scheme-indent-function 1)
 424       (put 'unbound\?-components 'scheme-indent-function 1)
 425       (put 'variable-components 'scheme-indent-function 1)))
 426
 427 (provide 'scheme)
 428
 429 ;;; scheme.el ends here