scheme.el 23 KB

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