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