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