![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to scheme.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to scheme.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 ! root 1: ;; Scheme mode, and its idiosyncratic commands. ! 2: ;; Copyright (C) 1986, 1987, 1988, 1990 Free Software Foundation, Inc. ! 3: ;; Adapted from Lisp mode by Bill Rozas, jinx@prep. ! 4: ! 5: ;; This file is part of GNU Emacs. ! 6: ! 7: ;; GNU Emacs is free software; you can redistribute it and/or modify ! 8: ;; it under the terms of the GNU General Public License as published by ! 9: ;; the Free Software Foundation; either version 1, or (at your option) ! 10: ;; any later version. ! 11: ! 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: ! 17: ;; You should have received a copy of the GNU General Public License ! 18: ;; along with GNU Emacs; see the file COPYING. If not, write to ! 19: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ! 20: ! 21: ! 22: ;; Initially a query replace of Lisp mode, except for the indentation ! 23: ;; of special forms. Probably the code should be merged at some point ! 24: ;; so that there is sharing between both libraries. ! 25: ! 26: ;;; $Header: scheme.el,v 1.7 88/07/15 20:20:00 GMT cph Exp $ ! 27: ! 28: (provide 'scheme) ! 29: ! 30: (defvar scheme-mode-syntax-table nil "") ! 31: (if (not scheme-mode-syntax-table) ! 32: (let ((i 0)) ! 33: (setq scheme-mode-syntax-table (make-syntax-table)) ! 34: (set-syntax-table scheme-mode-syntax-table) ! 35: ! 36: ;; Default is atom-constituent. ! 37: (while (< i 256) ! 38: (modify-syntax-entry i "_ ") ! 39: (setq i (1+ i))) ! 40: ! 41: ;; Word components. ! 42: (setq i ?0) ! 43: (while (<= i ?9) ! 44: (modify-syntax-entry i "w ") ! 45: (setq i (1+ i))) ! 46: (setq i ?A) ! 47: (while (<= i ?Z) ! 48: (modify-syntax-entry i "w ") ! 49: (setq i (1+ i))) ! 50: (setq i ?a) ! 51: (while (<= i ?z) ! 52: (modify-syntax-entry i "w ") ! 53: (setq i (1+ i))) ! 54: ! 55: ;; Whitespace ! 56: (modify-syntax-entry ?\t " ") ! 57: (modify-syntax-entry ?\n "> ") ! 58: (modify-syntax-entry ?\f " ") ! 59: (modify-syntax-entry ?\r " ") ! 60: (modify-syntax-entry ? " ") ! 61: ! 62: ;; These characters are delimiters but otherwise undefined. ! 63: ;; Brackets and braces balance for editing convenience. ! 64: (modify-syntax-entry ?[ "(] ") ! 65: (modify-syntax-entry ?] ")[ ") ! 66: (modify-syntax-entry ?{ "(} ") ! 67: (modify-syntax-entry ?} "){ ") ! 68: (modify-syntax-entry ?\| " ") ! 69: ! 70: ;; Other atom delimiters ! 71: (modify-syntax-entry ?\( "() ") ! 72: (modify-syntax-entry ?\) ")( ") ! 73: (modify-syntax-entry ?\; "< ") ! 74: (modify-syntax-entry ?\" "\" ") ! 75: (modify-syntax-entry ?' "' ") ! 76: (modify-syntax-entry ?` "' ") ! 77: ! 78: ;; Special characters ! 79: (modify-syntax-entry ?, "' ") ! 80: (modify-syntax-entry ?@ "' ") ! 81: (modify-syntax-entry ?# "' ") ! 82: (modify-syntax-entry ?\\ "\\ "))) ! 83: ! 84: (defvar scheme-mode-abbrev-table nil "") ! 85: (define-abbrev-table 'scheme-mode-abbrev-table ()) ! 86: ! 87: (defun scheme-mode-variables () ! 88: (set-syntax-table scheme-mode-syntax-table) ! 89: (setq local-abbrev-table scheme-mode-abbrev-table) ! 90: (make-local-variable 'paragraph-start) ! 91: (setq paragraph-start (concat "^$\\|" page-delimiter)) ! 92: (make-local-variable 'paragraph-separate) ! 93: (setq paragraph-separate paragraph-start) ! 94: (make-local-variable 'paragraph-ignore-fill-prefix) ! 95: (setq paragraph-ignore-fill-prefix t) ! 96: (make-local-variable 'indent-line-function) ! 97: (setq indent-line-function 'scheme-indent-line) ! 98: (make-local-variable 'comment-start) ! 99: (setq comment-start ";") ! 100: (make-local-variable 'comment-start-skip) ! 101: (setq comment-start-skip ";+[ \t]*") ! 102: (make-local-variable 'comment-column) ! 103: (setq comment-column 40) ! 104: (make-local-variable 'comment-indent-hook) ! 105: (setq comment-indent-hook 'scheme-comment-indent) ! 106: (setq mode-line-process '("" scheme-mode-line-process))) ! 107: ! 108: (defvar scheme-mode-line-process "") ! 109: ! 110: (defun scheme-mode-commands (map) ! 111: (define-key map "\t" 'scheme-indent-line) ! 112: (define-key map "\177" 'backward-delete-char-untabify) ! 113: (define-key map "\e\C-q" 'scheme-indent-sexp)) ! 114: ! 115: (defvar scheme-mode-map nil) ! 116: (if (not scheme-mode-map) ! 117: (progn ! 118: (setq scheme-mode-map (make-sparse-keymap)) ! 119: (scheme-mode-commands scheme-mode-map))) ! 120: ! 121: (defun scheme-mode () ! 122: "Major mode for editing Scheme code. ! 123: Editing commands are similar to those of lisp-mode. ! 124: ! 125: In addition, if an inferior Scheme process is running, some additional ! 126: commands will be defined, for evaluating expressions and controlling ! 127: the interpreter, and the state of the process will be displayed in the ! 128: modeline of all Scheme buffers. The names of commands that interact ! 129: with the Scheme process start with \"xscheme-\". For more information ! 130: see the documentation for xscheme-interaction-mode. ! 131: ! 132: Commands: ! 133: Delete converts tabs to spaces as it moves back. ! 134: Blank lines separate paragraphs. Semicolons start comments. ! 135: \\{scheme-mode-map} ! 136: Entry to this mode calls the value of scheme-mode-hook ! 137: if that value is non-nil." ! 138: (interactive) ! 139: (kill-all-local-variables) ! 140: (scheme-mode-initialize) ! 141: (scheme-mode-variables) ! 142: (run-hooks 'scheme-mode-hook)) ! 143: ! 144: (defun scheme-mode-initialize () ! 145: (use-local-map scheme-mode-map) ! 146: (setq major-mode 'scheme-mode) ! 147: (setq mode-name "Scheme")) ! 148: ! 149: (defvar scheme-mit-dialect t ! 150: "If non-nil, scheme mode is specialized for MIT Scheme. ! 151: Set this to nil if you normally use another dialect.") ! 152: ! 153: (defun scheme-comment-indent (&optional pos) ! 154: (save-excursion ! 155: (if pos (goto-char pos)) ! 156: (cond ((looking-at ";;;") (current-column)) ! 157: ((looking-at ";;") ! 158: (let ((tem (calculate-scheme-indent))) ! 159: (if (listp tem) (car tem) tem))) ! 160: (t ! 161: (skip-chars-backward " \t") ! 162: (max (if (bolp) 0 (1+ (current-column))) ! 163: comment-column))))) ! 164: ! 165: (defvar scheme-indent-offset nil "") ! 166: (defvar scheme-indent-hook 'scheme-indent-hook "") ! 167: ! 168: (defun scheme-indent-line (&optional whole-exp) ! 169: "Indent current line as Scheme code. ! 170: With argument, indent any additional lines of the same expression ! 171: rigidly along with this one." ! 172: (interactive "P") ! 173: (let ((indent (calculate-scheme-indent)) shift-amt beg end ! 174: (pos (- (point-max) (point)))) ! 175: (beginning-of-line) ! 176: (setq beg (point)) ! 177: (skip-chars-forward " \t") ! 178: (if (looking-at "[ \t]*;;;") ! 179: ;; Don't alter indentation of a ;;; comment line. ! 180: nil ! 181: (if (listp indent) (setq indent (car indent))) ! 182: (setq shift-amt (- indent (current-column))) ! 183: (if (zerop shift-amt) ! 184: nil ! 185: (delete-region beg (point)) ! 186: (indent-to indent)) ! 187: ;; If initial point was within line's indentation, ! 188: ;; position after the indentation. Else stay at same point in text. ! 189: (if (> (- (point-max) pos) (point)) ! 190: (goto-char (- (point-max) pos))) ! 191: ;; If desired, shift remaining lines of expression the same amount. ! 192: (and whole-exp (not (zerop shift-amt)) ! 193: (save-excursion ! 194: (goto-char beg) ! 195: (forward-sexp 1) ! 196: (setq end (point)) ! 197: (goto-char beg) ! 198: (forward-line 1) ! 199: (setq beg (point)) ! 200: (> end beg)) ! 201: (indent-code-rigidly beg end shift-amt))))) ! 202: ! 203: (defun calculate-scheme-indent (&optional parse-start) ! 204: "Return appropriate indentation for current line as scheme code. ! 205: In usual case returns an integer: the column to indent to. ! 206: Can instead return a list, whose car is the column to indent to. ! 207: This means that following lines at the same level of indentation ! 208: should not necessarily be indented the same way. ! 209: The second element of the list is the buffer position ! 210: of the start of the containing expression." ! 211: (save-excursion ! 212: (beginning-of-line) ! 213: (let ((indent-point (point)) state paren-depth desired-indent (retry t) ! 214: last-sexp containing-sexp first-sexp-list-p) ! 215: (if parse-start ! 216: (goto-char parse-start) ! 217: (beginning-of-defun)) ! 218: ;; Find outermost containing sexp ! 219: (while (< (point) indent-point) ! 220: (setq state (parse-partial-sexp (point) indent-point 0))) ! 221: ;; Find innermost containing sexp ! 222: (while (and retry (setq paren-depth (car state)) (> paren-depth 0)) ! 223: (setq retry nil) ! 224: (setq last-sexp (nth 2 state)) ! 225: (setq containing-sexp (car (cdr state))) ! 226: ;; Position following last unclosed open. ! 227: (goto-char (1+ containing-sexp)) ! 228: ;; Is there a complete sexp since then? ! 229: (if (and last-sexp (> last-sexp (point))) ! 230: ;; Yes, but is there a containing sexp after that? ! 231: (let ((peek (parse-partial-sexp last-sexp indent-point 0))) ! 232: (if (setq retry (car (cdr peek))) (setq state peek)))) ! 233: (if (not retry) ! 234: ;; Innermost containing sexp found ! 235: (progn ! 236: (goto-char (1+ containing-sexp)) ! 237: (if (not last-sexp) ! 238: ;; indent-point immediately follows open paren. ! 239: ;; Don't call hook. ! 240: (setq desired-indent (current-column)) ! 241: ;; Move to first sexp after containing open paren ! 242: (parse-partial-sexp (point) last-sexp 0 t) ! 243: (setq first-sexp-list-p (looking-at "\\s(")) ! 244: (cond ! 245: ((> (save-excursion (forward-line 1) (point)) ! 246: last-sexp) ! 247: ;; Last sexp is on same line as containing sexp. ! 248: ;; It's almost certainly a function call. ! 249: (parse-partial-sexp (point) last-sexp 0 t) ! 250: (if (/= (point) last-sexp) ! 251: ;; Indent beneath first argument or, if only one sexp ! 252: ;; on line, indent beneath that. ! 253: (progn (forward-sexp 1) ! 254: (parse-partial-sexp (point) last-sexp 0 t))) ! 255: (backward-prefix-chars)) ! 256: (t ! 257: ;; Indent beneath first sexp on same line as last-sexp. ! 258: ;; Again, it's almost certainly a function call. ! 259: (goto-char last-sexp) ! 260: (beginning-of-line) ! 261: (parse-partial-sexp (point) last-sexp 0 t) ! 262: (backward-prefix-chars))))))) ! 263: ;; If looking at a list, don't call hook. ! 264: (if first-sexp-list-p ! 265: (setq desired-indent (current-column))) ! 266: ;; Point is at the point to indent under unless we are inside a string. ! 267: ;; Call indentation hook except when overriden by scheme-indent-offset ! 268: ;; or if the desired indentation has already been computed. ! 269: (cond ((car (nthcdr 3 state)) ! 270: ;; Inside a string, don't change indentation. ! 271: (goto-char indent-point) ! 272: (skip-chars-forward " \t") ! 273: (setq desired-indent (current-column))) ! 274: ((and (integerp scheme-indent-offset) containing-sexp) ! 275: ;; Indent by constant offset ! 276: (goto-char containing-sexp) ! 277: (setq desired-indent (+ scheme-indent-offset (current-column)))) ! 278: ((not (or desired-indent ! 279: (and (boundp 'scheme-indent-hook) ! 280: scheme-indent-hook ! 281: (not retry) ! 282: (setq desired-indent ! 283: (funcall scheme-indent-hook ! 284: indent-point state))))) ! 285: ;; Use default indentation if not computed yet ! 286: (setq desired-indent (current-column)))) ! 287: desired-indent))) ! 288: ! 289: (defun scheme-indent-hook (indent-point state) ! 290: (let ((normal-indent (current-column))) ! 291: (save-excursion ! 292: (goto-char (1+ (car (cdr state)))) ! 293: (re-search-forward "\\sw\\|\\s_") ! 294: (if (/= (point) (car (cdr state))) ! 295: (let ((function (buffer-substring (progn (forward-char -1) (point)) ! 296: (progn (forward-sexp 1) (point)))) ! 297: method) ! 298: ;; Who cares about this, really? ! 299: ;(if (not (string-match "\\\\\\||" function))) ! 300: (setq function (downcase function)) ! 301: (setq method (get (intern-soft function) 'scheme-indent-hook)) ! 302: (cond ((integerp method) ! 303: (scheme-indent-specform method state indent-point)) ! 304: (method ! 305: (funcall method state indent-point)) ! 306: ((and (> (length function) 3) ! 307: (string-equal (substring function 0 3) "def")) ! 308: (scheme-indent-defform state indent-point)))))))) ! 309: ! 310: (defvar scheme-body-indent 2 "") ! 311: ! 312: (defun scheme-indent-specform (count state indent-point) ! 313: (let ((containing-form-start (car (cdr state))) (i count) ! 314: body-indent containing-form-column) ! 315: ;; Move to the start of containing form, calculate indentation ! 316: ;; to use for non-distinguished forms (> count), and move past the ! 317: ;; function symbol. scheme-indent-hook guarantees that there is at ! 318: ;; least one word or symbol character following open paren of containing ! 319: ;; form. ! 320: (goto-char containing-form-start) ! 321: (setq containing-form-column (current-column)) ! 322: (setq body-indent (+ scheme-body-indent containing-form-column)) ! 323: (forward-char 1) ! 324: (forward-sexp 1) ! 325: ;; Now find the start of the last form. ! 326: (parse-partial-sexp (point) indent-point 1 t) ! 327: (while (and (< (point) indent-point) ! 328: (condition-case nil ! 329: (progn ! 330: (setq count (1- count)) ! 331: (forward-sexp 1) ! 332: (parse-partial-sexp (point) indent-point 1 t)) ! 333: (error nil)))) ! 334: ;; Point is sitting on first character of last (or count) sexp. ! 335: (cond ((> count 0) ! 336: ;; A distinguished form. Use double scheme-body-indent. ! 337: (list (+ containing-form-column (* 2 scheme-body-indent)) ! 338: containing-form-start)) ! 339: ;; A non-distinguished form. Use body-indent if there are no ! 340: ;; distinguished forms and this is the first undistinguished ! 341: ;; form, or if this is the first undistinguished form and ! 342: ;; the preceding distinguished form has indentation at least ! 343: ;; as great as body-indent. ! 344: ((and (= count 0) ! 345: (or (= i 0) ! 346: (<= body-indent normal-indent))) ! 347: body-indent) ! 348: (t ! 349: normal-indent)))) ! 350: ! 351: (defun scheme-indent-defform (state indent-point) ! 352: (goto-char (car (cdr state))) ! 353: (forward-line 1) ! 354: (if (> (point) (car (cdr (cdr state)))) ! 355: (progn ! 356: (goto-char (car (cdr state))) ! 357: (+ scheme-body-indent (current-column))))) ! 358: ! 359: ;;; Let is different in Scheme ! 360: ! 361: (defun would-be-symbol (string) ! 362: (not (string-equal (substring string 0 1) "("))) ! 363: ! 364: (defun next-sexp-as-string () ! 365: ;; Assumes that protected by a save-excursion ! 366: (forward-sexp 1) ! 367: (let ((the-end (point))) ! 368: (backward-sexp 1) ! 369: (buffer-substring (point) the-end))) ! 370: ! 371: ;; This is correct but too slow. ! 372: ;; The one below works almost always. ! 373: ;;(defun scheme-let-indent (state indent-point) ! 374: ;; (if (would-be-symbol (next-sexp-as-string)) ! 375: ;; (scheme-indent-specform 2 state indent-point) ! 376: ;; (scheme-indent-specform 1 state indent-point))) ! 377: ! 378: (defun scheme-let-indent (state indent-point) ! 379: (skip-chars-forward " \t") ! 380: (if (looking-at "[a-zA-Z0-9+-*/?!@$%^&_:~]") ! 381: (scheme-indent-specform 2 state indent-point) ! 382: (scheme-indent-specform 1 state indent-point))) ! 383: ! 384: ;; (put 'begin 'scheme-indent-hook 0), say, causes begin to be indented ! 385: ;; like defun if the first form is placed on the next line, otherwise ! 386: ;; it is indented like any other form (i.e. forms line up under first). ! 387: ! 388: (put 'begin 'scheme-indent-hook 0) ! 389: (put 'case 'scheme-indent-hook 1) ! 390: (put 'delay 'scheme-indent-hook 0) ! 391: (put 'do 'scheme-indent-hook 2) ! 392: (put 'lambda 'scheme-indent-hook 1) ! 393: (put 'let 'scheme-indent-hook 'scheme-let-indent) ! 394: (put 'let* 'scheme-indent-hook 1) ! 395: (put 'letrec 'scheme-indent-hook 1) ! 396: (put 'sequence 'scheme-indent-hook 0) ! 397: ! 398: (put 'call-with-input-file 'scheme-indent-hook 1) ! 399: (put 'with-input-from-file 'scheme-indent-hook 1) ! 400: (put 'with-input-from-port 'scheme-indent-hook 1) ! 401: (put 'call-with-output-file 'scheme-indent-hook 1) ! 402: (put 'with-output-to-file 'scheme-indent-hook 1) ! 403: (put 'with-output-to-port 'scheme-indent-hook 1) ! 404: ! 405: ;;;; MIT Scheme specific indentation. ! 406: ! 407: (if scheme-mit-dialect ! 408: (progn ! 409: (put 'fluid-let 'scheme-indent-hook 1) ! 410: (put 'in-package 'scheme-indent-hook 1) ! 411: (put 'let-syntax 'scheme-indent-hook 1) ! 412: (put 'local-declare 'scheme-indent-hook 1) ! 413: (put 'macro 'scheme-indent-hook 1) ! 414: (put 'make-environment 'scheme-indent-hook 0) ! 415: (put 'named-lambda 'scheme-indent-hook 1) ! 416: (put 'using-syntax 'scheme-indent-hook 1) ! 417: ! 418: (put 'with-input-from-string 'scheme-indent-hook 1) ! 419: (put 'with-output-to-string 'scheme-indent-hook 0) ! 420: (put 'with-values 'scheme-indent-hook 1) ! 421: ! 422: (put 'syntax-table-define 'scheme-indent-hook 2) ! 423: (put 'list-transform-positive 'scheme-indent-hook 1) ! 424: (put 'list-transform-negative 'scheme-indent-hook 1) ! 425: (put 'list-search-positive 'scheme-indent-hook 1) ! 426: (put 'list-search-negative 'scheme-indent-hook 1) ! 427: ! 428: (put 'access-components 'scheme-indent-hook 1) ! 429: (put 'assignment-components 'scheme-indent-hook 1) ! 430: (put 'combination-components 'scheme-indent-hook 1) ! 431: (put 'comment-components 'scheme-indent-hook 1) ! 432: (put 'conditional-components 'scheme-indent-hook 1) ! 433: (put 'disjunction-components 'scheme-indent-hook 1) ! 434: (put 'declaration-components 'scheme-indent-hook 1) ! 435: (put 'definition-components 'scheme-indent-hook 1) ! 436: (put 'delay-components 'scheme-indent-hook 1) ! 437: (put 'in-package-components 'scheme-indent-hook 1) ! 438: (put 'lambda-components 'scheme-indent-hook 1) ! 439: (put 'lambda-components* 'scheme-indent-hook 1) ! 440: (put 'lambda-components** 'scheme-indent-hook 1) ! 441: (put 'open-block-components 'scheme-indent-hook 1) ! 442: (put 'pathname-components 'scheme-indent-hook 1) ! 443: (put 'procedure-components 'scheme-indent-hook 1) ! 444: (put 'sequence-components 'scheme-indent-hook 1) ! 445: (put 'unassigned\?-components 'scheme-indent-hook 1) ! 446: (put 'unbound\?-components 'scheme-indent-hook 1) ! 447: (put 'variable-components 'scheme-indent-hook 1))) ! 448: ! 449: (defun scheme-indent-sexp () ! 450: "Indent each line of the list starting just after point." ! 451: (interactive) ! 452: (let ((indent-stack (list nil)) (next-depth 0) bol ! 453: outer-loop-done inner-loop-done state this-indent) ! 454: (save-excursion (forward-sexp 1)) ! 455: (save-excursion ! 456: (setq outer-loop-done nil) ! 457: (while (not outer-loop-done) ! 458: (setq last-depth next-depth ! 459: innerloop-done nil) ! 460: (while (and (not innerloop-done) ! 461: (not (setq outer-loop-done (eobp)))) ! 462: (setq state (parse-partial-sexp (point) (progn (end-of-line) (point)) ! 463: nil nil state)) ! 464: (setq next-depth (car state)) ! 465: (if (car (nthcdr 4 state)) ! 466: (progn (indent-for-comment) ! 467: (end-of-line) ! 468: (setcar (nthcdr 4 state) nil))) ! 469: (if (car (nthcdr 3 state)) ! 470: (progn ! 471: (forward-line 1) ! 472: (setcar (nthcdr 5 state) nil)) ! 473: (setq innerloop-done t))) ! 474: (if (setq outer-loop-done (<= next-depth 0)) ! 475: nil ! 476: (while (> last-depth next-depth) ! 477: (setq indent-stack (cdr indent-stack) ! 478: last-depth (1- last-depth))) ! 479: (while (< last-depth next-depth) ! 480: (setq indent-stack (cons nil indent-stack) ! 481: last-depth (1+ last-depth))) ! 482: (forward-line 1) ! 483: (setq bol (point)) ! 484: (skip-chars-forward " \t") ! 485: (if (or (eobp) (looking-at "[;\n]")) ! 486: nil ! 487: (if (and (car indent-stack) ! 488: (>= (car indent-stack) 0)) ! 489: (setq this-indent (car indent-stack)) ! 490: (let ((val (calculate-scheme-indent ! 491: (if (car indent-stack) (- (car indent-stack)))))) ! 492: (if (integerp val) ! 493: (setcar indent-stack ! 494: (setq this-indent val)) ! 495: (setcar indent-stack (- (car (cdr val)))) ! 496: (setq this-indent (car val))))) ! 497: (if (/= (current-column) this-indent) ! 498: (progn (delete-region bol (point)) ! 499: (indent-to this-indent)))))))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.