![[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 [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp|
Return to scheme.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 ! root 1: ;; Scheme mode, and its idiosyncratic commands. ! 2: ;; Copyright (C) 1985 Bill Rozas & Richard M. Stallman ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is distributed in the hope that it will be useful, ! 7: ;; but WITHOUT ANY WARRANTY. No author or distributor ! 8: ;; accepts responsibility to anyone for the consequences of using it ! 9: ;; or for whether it serves any particular purpose or works at all, ! 10: ;; unless he says so in writing. Refer to the GNU Emacs General Public ! 11: ;; License for full details. ! 12: ! 13: ;; Everyone is granted permission to copy, modify and redistribute ! 14: ;; GNU Emacs, but only under the conditions described in the ! 15: ;; GNU Emacs General Public License. A copy of this license is ! 16: ;; supposed to have been given to you along with GNU Emacs so you ! 17: ;; can know your rights and responsibilities. It should be in a ! 18: ;; file named COPYING. Among other things, the copyright notice ! 19: ;; and this notice must be preserved on all copies. ! 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: (provide 'scheme) ! 27: ! 28: (defvar scheme-mode-syntax-table nil "") ! 29: (defvar scheme-mode-abbrev-table nil "") ! 30: ! 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: (while (< i ?0) ! 36: (modify-syntax-entry i "_ ") ! 37: (setq i (1+ i))) ! 38: (setq i (1+ ?9)) ! 39: (while (< i ?A) ! 40: (modify-syntax-entry i "_ ") ! 41: (setq i (1+ i))) ! 42: (setq i (1+ ?Z)) ! 43: (while (< i ?a) ! 44: (modify-syntax-entry i "_ ") ! 45: (setq i (1+ i))) ! 46: (setq i (1+ ?z)) ! 47: (while (< i 128) ! 48: (modify-syntax-entry i "_ ") ! 49: (setq i (1+ i))) ! 50: (modify-syntax-entry ? " ") ! 51: (modify-syntax-entry ?\t " ") ! 52: (modify-syntax-entry ?\n "> ") ! 53: (modify-syntax-entry ?\f "> ") ! 54: (modify-syntax-entry ?\; "< ") ! 55: (modify-syntax-entry ?` "' ") ! 56: (modify-syntax-entry ?' "' ") ! 57: (modify-syntax-entry ?, "' ") ! 58: (modify-syntax-entry ?. "' ") ! 59: (modify-syntax-entry ?# "' ") ! 60: (modify-syntax-entry ?\" "\" ") ! 61: (modify-syntax-entry ?\\ "\\ ") ! 62: (modify-syntax-entry ?\( "() ") ! 63: (modify-syntax-entry ?\) ")( "))) ! 64: ! 65: (define-abbrev-table 'scheme-mode-abbrev-table ()) ! 66: ! 67: (defun scheme-mode-variables () ! 68: (set-syntax-table scheme-mode-syntax-table) ! 69: (setq local-abbrev-table scheme-mode-abbrev-table) ! 70: (make-local-variable 'paragraph-start) ! 71: (setq paragraph-start (concat "^$\\|" page-delimiter)) ! 72: (make-local-variable 'paragraph-separate) ! 73: (setq paragraph-separate paragraph-start) ! 74: (make-local-variable 'indent-line-function) ! 75: (setq indent-line-function 'scheme-indent-line) ! 76: (make-local-variable 'comment-start) ! 77: (setq comment-start ";") ! 78: (make-local-variable 'comment-start-skip) ! 79: (setq comment-start-skip ";+ *") ! 80: (make-local-variable 'comment-column) ! 81: (setq comment-column 40) ! 82: (make-local-variable 'comment-indent-hook) ! 83: (setq comment-indent-hook 'scheme-comment-indent)) ! 84: ! 85: (defun scheme-mode-commands (map) ! 86: (define-key map "\t" 'scheme-indent-line) ! 87: (define-key map "\177" 'backward-delete-char-untabify) ! 88: (define-key map "\eo" 'scheme-send-buffer) ! 89: (define-key map "\ez" 'scheme-zap-define) ! 90: (define-key map "\e\C-q" 'scheme-indent-sexp) ! 91: (define-key map "\e\C-s" 'find-scheme-definition) ! 92: (define-key map "\e\C-y" 'scheme-zap-define-and-resume) ! 93: (define-key map "\e\C-z" 'resume-scheme)) ! 94: ! 95: (defvar scheme-mode-map (make-sparse-keymap)) ! 96: ;; (define-key scheme-mode-map "\e\C-x" 'scheme-send-definition) ! 97: (scheme-mode-commands scheme-mode-map) ! 98: ! 99: (defun scheme-mode () ! 100: "Major mode for editing Scheme code. ! 101: Commands: ! 102: Delete converts tabs to spaces as it moves back. ! 103: Blank lines separate paragraphs. Semicolons start comments. ! 104: \\{scheme-mode-map} ! 105: Entry to this mode calls the value of scheme-mode-hook ! 106: if that value is non-nil." ! 107: (interactive) ! 108: (kill-all-local-variables) ! 109: (use-local-map scheme-mode-map) ! 110: (setq major-mode 'scheme-mode) ! 111: (setq mode-name "Scheme") ! 112: (scheme-mode-variables) ! 113: (run-hooks 'scheme-mode-hook)) ! 114: ! 115: ;; This will do unless shell.el is loaded. ! 116: (defun scheme-send-definition () ! 117: "Send the current definition to the Scheme process made by M-x run-scheme." ! 118: (interactive) ! 119: (error "Process scheme does not exist")) ! 120: ! 121: (defun scheme-comment-indent (&optional pos) ! 122: (save-excursion ! 123: (if pos (goto-char pos)) ! 124: (if (looking-at ";;;") ! 125: (current-column) ! 126: (if (looking-at ";;") ! 127: (let ((tem (calculate-scheme-indent))) ! 128: (if (listp tem) (car tem) tem)) ! 129: comment-column)))) ! 130: ! 131: (defvar scheme-indent-offset nil "") ! 132: (defvar scheme-indent-hook 'scheme-indent-hook "") ! 133: ! 134: (defun scheme-indent-line (&optional whole-exp) ! 135: "Indent current line as Scheme code. ! 136: With argument, indent any additional lines of the same expression ! 137: rigidly along with this one." ! 138: (interactive "P") ! 139: (let ((indent (calculate-scheme-indent)) shift-amt beg end ! 140: (pos (- (point-max) (point)))) ! 141: (beginning-of-line) ! 142: (setq beg (point)) ! 143: (skip-chars-forward " \t") ! 144: (if (looking-at "[ \t]*;;;") ! 145: ;; Don't alter indentation of a ;;; comment line. ! 146: nil ! 147: (if (listp indent) (setq indent (car indent))) ! 148: (setq shift-amt (- indent (current-column))) ! 149: (if (zerop shift-amt) ! 150: nil ! 151: (delete-region beg (point)) ! 152: (indent-to indent)) ! 153: ;; If initial point was within line's indentation, ! 154: ;; position after the indentation. Else stay at same point in text. ! 155: (if (> (- (point-max) pos) (point)) ! 156: (goto-char (- (point-max) pos))) ! 157: ;; If desired, shift remaining lines of expression the same amount. ! 158: (and whole-exp (not (zerop shift-amt)) ! 159: (save-excursion ! 160: (goto-char beg) ! 161: (forward-sexp 1) ! 162: (setq end (point)) ! 163: (goto-char beg) ! 164: (forward-line 1) ! 165: (setq beg (point)) ! 166: (> end beg)) ! 167: (indent-code-rigidly beg end shift-amt))))) ! 168: ! 169: (defun calculate-scheme-indent (&optional parse-start) ! 170: "Return appropriate indentation for current line as scheme code. ! 171: In usual case returns an integer: the column to indent to. ! 172: Can instead return a list, whose car is the column to indent to. ! 173: This means that following lines at the same level of indentation ! 174: should not necessarily be indented the same way. ! 175: The second element of the list is the buffer position ! 176: of the start of the containing expression." ! 177: (save-excursion ! 178: (beginning-of-line) ! 179: (let ((indent-point (point)) state paren-depth desired-indent (retry t) ! 180: last-sexp containing-sexp) ! 181: (if parse-start ! 182: (goto-char parse-start) ! 183: (beginning-of-defun)) ! 184: ;; Find outermost containing sexp ! 185: (while (< (point) indent-point) ! 186: (setq state (parse-partial-sexp (point) indent-point 0))) ! 187: ;; Find innermost containing sexp ! 188: (while (and retry (setq paren-depth (car state)) (> paren-depth 0)) ! 189: (setq retry nil) ! 190: (setq last-sexp (nth 2 state)) ! 191: (setq containing-sexp (car (cdr state))) ! 192: ;; Position following last unclosed open. ! 193: (goto-char (1+ containing-sexp)) ! 194: ;; Is there a complete sexp since then? ! 195: (if (and last-sexp (> last-sexp (point))) ! 196: ;; Yes, but is there a containing sexp after that? ! 197: (let ((peek (parse-partial-sexp last-sexp indent-point 0))) ! 198: (if (setq retry (car (cdr peek))) (setq state peek)))) ! 199: (if (not retry) ! 200: ;; Innermost containing sexp found ! 201: (progn ! 202: (goto-char (1+ containing-sexp)) ! 203: (if (not last-sexp) ! 204: ;; indent-point immediately follows open paren. ! 205: ;; Don't call hook. ! 206: (setq desired-indent (current-column)) ! 207: ;; Move to first sexp after containing open paren ! 208: (parse-partial-sexp (point) last-sexp 0 t) ! 209: (cond ! 210: ((looking-at "\\s(") ! 211: ;; Looking at a list. Don't call hook. ! 212: (if (not (> (save-excursion (forward-line 1) (point)) last-sexp)) ! 213: (progn (goto-char last-sexp) ! 214: (beginning-of-line) ! 215: (parse-partial-sexp (point) last-sexp 0 t))) ! 216: ;; Indent under the list or under the first sexp on the ! 217: ;; same line as last-sexp. Note that first thing on that ! 218: ;; line has to be complete sexp since we are inside the ! 219: ;; innermost containing sexp. ! 220: (backward-prefix-chars) ! 221: (setq desired-indent (current-column))) ! 222: ((> (save-excursion (forward-line 1) (point)) ! 223: last-sexp) ! 224: ;; Last sexp is on same line as containing sexp. ! 225: ;; It's almost certainly a function call. ! 226: (parse-partial-sexp (point) last-sexp 0 t) ! 227: (if (/= (point) last-sexp) ! 228: ;; Indent beneath first argument or, if only one sexp ! 229: ;; on line, indent beneath that. ! 230: (progn (forward-sexp 1) ! 231: (parse-partial-sexp (point) last-sexp 0 t))) ! 232: (backward-prefix-chars)) ! 233: (t ! 234: ;; Indent beneath first sexp on same line as last-sexp. ! 235: ;; Again, it's almost certainly a function call. ! 236: (goto-char last-sexp) ! 237: (beginning-of-line) ! 238: (parse-partial-sexp (point) last-sexp 0 t) ! 239: (backward-prefix-chars))))))) ! 240: ;; Point is at the point to indent under unless we are inside a string. ! 241: ;; Call indentation hook except when overriden by scheme-indent-offset ! 242: ;; or if the desired indentation has already been computed. ! 243: (cond ((car (nthcdr 3 state)) ! 244: ;; Inside a string, don't change indentation. ! 245: (goto-char indent-point) ! 246: (skip-chars-forward " \t") ! 247: (setq desired-indent (current-column))) ! 248: ((and (integerp scheme-indent-offset) containing-sexp) ! 249: ;; Indent by constant offset ! 250: (goto-char containing-sexp) ! 251: (setq desired-indent (+ scheme-indent-offset (current-column)))) ! 252: ((not (or desired-indent ! 253: (and (boundp 'scheme-indent-hook) ! 254: scheme-indent-hook ! 255: (not retry) ! 256: (setq desired-indent ! 257: (funcall scheme-indent-hook ! 258: indent-point state))))) ! 259: ;; Use default indentation if not computed yet ! 260: (setq desired-indent (current-column)))) ! 261: desired-indent))) ! 262: ! 263: (defun scheme-indent-hook (indent-point state) ! 264: (let ((normal-indent (current-column))) ! 265: (save-excursion ! 266: (goto-char (1+ (car (cdr state)))) ! 267: (re-search-forward "\\sw\\|\\s_") ! 268: (if (/= (point) (car (cdr state))) ! 269: (let ((function (buffer-substring (progn (forward-char -1) (point)) ! 270: (progn (forward-sexp 1) (point)))) ! 271: method) ! 272: ;; Who cares about this, really? ! 273: ;(if (not (string-match "\\\\\\||" function))) ! 274: (setq function (downcase function)) ! 275: (setq method (get (intern-soft function) 'scheme-indent-hook)) ! 276: (cond ((integerp method) ! 277: (scheme-indent-specform method state indent-point)) ! 278: (method ! 279: (funcall method state indent-point)) ! 280: ((and (> (length function) 3) ! 281: (string-equal (substring function 0 3) "def")) ! 282: (scheme-indent-defform state indent-point)))))))) ! 283: ! 284: (defvar scheme-body-indent 2 "") ! 285: ! 286: (defun scheme-indent-specform (count state indent-point) ! 287: (let ((containing-form-start (car (cdr state))) (i count) ! 288: body-indent containing-form-column) ! 289: ;; Move to the start of containing form, calculate indentation ! 290: ;; to use for non-distinguished forms (> count), and move past the ! 291: ;; function symbol. scheme-indent-hook guarantees that there is at ! 292: ;; least one word or symbol character following open paren of containing ! 293: ;; form. ! 294: (goto-char containing-form-start) ! 295: (setq containing-form-column (current-column)) ! 296: (setq body-indent (+ scheme-body-indent containing-form-column)) ! 297: (forward-char 1) ! 298: (forward-sexp 1) ! 299: ;; Now find the start of the last form. ! 300: (parse-partial-sexp (point) indent-point 1 t) ! 301: (while (and (< (point) indent-point) ! 302: (condition-case nil ! 303: (progn ! 304: (setq count (1- count)) ! 305: (forward-sexp 1) ! 306: (parse-partial-sexp (point) indent-point 1 t)) ! 307: (error nil)))) ! 308: ;; Point is sitting on first character of last (or count) sexp. ! 309: (if (> count 0) ! 310: ;; A distinguished form. If it is the first or second form ! 311: ;; use double scheme-body-indent, else normal indent. With ! 312: ;; scheme-body-indent bound to 2 (the default), this just ! 313: ;; happens to work the same with if as the older code, but it ! 314: ;; makes unwind-protect, condition-case, ! 315: ;; with-output-to-temp-buffer, et. al. much more tasteful. ! 316: ;; The older, less hacked, behavior can be obtained by ! 317: ;; replacing below with (list normal-indent containing-form-start). ! 318: (if (<= (- i count) 1) ! 319: (list (+ containing-form-column (* 2 scheme-body-indent)) ! 320: containing-form-start) ! 321: (list normal-indent containing-form-start)) ! 322: ;; A non-distinguished form. Use body-indent if there are no ! 323: ;; distinguished forms and this is the first undistinguished ! 324: ;; form, or if this is the first undistinguished form and ! 325: ;; the preceding distinguished form has indentation at ! 326: ;; least as great as body-indent. ! 327: (if (or (and (= i 0) (= count 0)) ! 328: (and (= count 0) (<= body-indent normal-indent))) ! 329: body-indent ! 330: normal-indent)))) ! 331: ! 332: (defun scheme-indent-defform (state indent-point) ! 333: (goto-char (car (cdr state))) ! 334: (forward-line 1) ! 335: (if (> (point) (car (cdr (cdr state)))) ! 336: (progn ! 337: (goto-char (car (cdr state))) ! 338: (+ scheme-body-indent (current-column))))) ! 339: ! 340: ;;; Let is different in Scheme ! 341: ! 342: (defun would-be-symbol (string) ! 343: (not (string-equal (substring string 0 1) "("))) ! 344: ! 345: (defun next-sexp-as-string () ! 346: ;; Assumes that protected by a save-excursion ! 347: (forward-sexp 1) ! 348: (let ((the-end (point))) ! 349: (backward-sexp 1) ! 350: (buffer-substring (point) the-end))) ! 351: ! 352: ;; This is correct but too slow. ! 353: ;; The one below works almost always. ! 354: ;;(defun scheme-let-indent (state indent-point) ! 355: ;; (if (would-be-symbol (next-sexp-as-string)) ! 356: ;; (scheme-indent-specform 2 state indent-point) ! 357: ;; (scheme-indent-specform 1 state indent-point))) ! 358: ! 359: (defun scheme-let-indent (state indent-point) ! 360: (skip-chars-forward " \t") ! 361: (if (looking-at "[a-zA-Z0-9+-*/?!@$%^&_:~]") ! 362: (scheme-indent-specform 2 state indent-point) ! 363: (scheme-indent-specform 1 state indent-point))) ! 364: ! 365: ;; (put 'begin 'scheme-indent-hook 0), say, causes begin to be indented ! 366: ;; like defun if the first form is placed on the next line, otherwise ! 367: ;; it is indented like any other form (i.e. forms line up under first). ! 368: ! 369: (put 'begin 'scheme-indent-hook 0) ! 370: (put 'case 'scheme-indent-hook 1) ! 371: (put 'do 'scheme-indent-hook 2) ! 372: (put 'fluid-let 'scheme-indent-hook 1) ! 373: (put 'if 'scheme-indent-hook 3) ! 374: (put 'in-package 'scheme-indent-hook 1) ! 375: (put 'lambda 'scheme-indent-hook 1) ! 376: (put 'let 'scheme-indent-hook 'scheme-let-indent) ! 377: (put 'let* 'scheme-indent-hook 1) ! 378: (put 'let-syntax 'scheme-indent-hook 1) ! 379: (put 'letrec 'scheme-indent-hook 1) ! 380: (put 'local-declare 'scheme-indent-hook 1) ! 381: (put 'macro 'scheme-indent-hook 1) ! 382: (put 'make-environment 'scheme-indent-hook 0) ! 383: (put 'make-package 'scheme-indent-hook 2) ! 384: (put 'named-lambda 'scheme-indent-hook 1) ! 385: (put 'sequence 'scheme-indent-hook 0) ! 386: (put 'using-syntax 'scheme-indent-hook 1) ! 387: ! 388: ! 389: (defun scheme-indent-sexp () ! 390: "Indent each line of the list starting just after point." ! 391: (interactive) ! 392: (let ((indent-stack (list nil)) (next-depth 0) bol ! 393: outer-loop-done inner-loop-done state this-indent) ! 394: (save-excursion (forward-sexp 1)) ! 395: (save-excursion ! 396: (setq outer-loop-done nil) ! 397: (while (not outer-loop-done) ! 398: (setq last-depth next-depth ! 399: innerloop-done nil) ! 400: (while (and (not innerloop-done) ! 401: (not (setq outer-loop-done (eobp)))) ! 402: (setq state (parse-partial-sexp (point) (progn (end-of-line) (point)) ! 403: nil nil state)) ! 404: (setq next-depth (car state)) ! 405: (if (car (nthcdr 4 state)) ! 406: (progn (indent-for-comment) ! 407: (end-of-line) ! 408: (setcar (nthcdr 4 state) nil))) ! 409: (if (car (nthcdr 3 state)) ! 410: (progn ! 411: (forward-line 1) ! 412: (setcar (nthcdr 5 state) nil)) ! 413: (setq innerloop-done t))) ! 414: (if (setq outer-loop-done (<= next-depth 0)) ! 415: nil ! 416: (while (> last-depth next-depth) ! 417: (setq indent-stack (cdr indent-stack) ! 418: last-depth (1- last-depth))) ! 419: (while (< last-depth next-depth) ! 420: (setq indent-stack (cons nil indent-stack) ! 421: last-depth (1+ last-depth))) ! 422: (forward-line 1) ! 423: (setq bol (point)) ! 424: (skip-chars-forward " \t") ! 425: (if (or (eobp) (looking-at "[;\n]")) ! 426: nil ! 427: (if (and (car indent-stack) ! 428: (>= (car indent-stack) 0)) ! 429: (setq this-indent (car indent-stack)) ! 430: (let ((val (calculate-scheme-indent ! 431: (if (car indent-stack) (- (car indent-stack)))))) ! 432: (if (integerp val) ! 433: (setcar indent-stack ! 434: (setq this-indent val)) ! 435: (setcar indent-stack (- (car (cdr val)))) ! 436: (setq this-indent (car val))))) ! 437: (if (/= (current-column) this-indent) ! 438: (progn (delete-region bol (point)) ! 439: (indent-to this-indent))))))))) ! 440: ! 441: ;;; Schedit commands (old scheme interface) ! 442: ! 443: (defvar scheme-zap-name (expand-file-name "fromedit.zap" nil) ! 444: "Name of transfer file between Scheme and Emacs") ! 445: ! 446: (defvar scheme-invocation-string "%scheme" ! 447: "*String to give to the Cshell to proceed a sibling Scheme") ! 448: ! 449: (defun goto-parallel-scheme-fork () ! 450: (suspend-emacs scheme-invocation-string)) ! 451: ! 452: ;; This currently assumes that Emacs runs as an inferior to Scheme ! 453: ! 454: (fset 'goto-scheme 'suspend-emacs) ! 455: ! 456: ;; if not, do (fset 'goto-scheme 'goto-parallel-scheme-fork) ! 457: ! 458: (defun resume-scheme () ! 459: "Suspend Emacs and resume Scheme" ! 460: (interactive) ! 461: (let ((zap-buffer (get-buffer scheme-zap-name)) ! 462: (this-buffer (current-buffer))) ! 463: (if zap-buffer ! 464: (save-excursion ! 465: (unwind-protect ! 466: (progn (set-buffer zap-buffer) ! 467: (or buffer-file-name ! 468: (setq buffer-file-name scheme-zap-name)) ! 469: (save-buffer) ! 470: (erase-buffer) ! 471: (setq buffer-modified-p nil)) ! 472: (set-buffer this-buffer))))) ! 473: (goto-scheme)) ! 474: ! 475: (defun scheme-do-zap-region (start end buffer &optional separate) ! 476: "Internal routine which zaps a region of text for Scheme." ! 477: (let ((the-text (buffer-substring start end))) ! 478: (save-excursion ! 479: (unwind-protect ! 480: (progn (set-buffer (get-buffer-create scheme-zap-name)) ! 481: (insert-string the-text) ! 482: (if separate (newline 2))) ! 483: (set-buffer buffer))))) ! 484: ! 485: (defun scheme-zap-region (start end) ! 486: "Zap region between point and mark into Scheme." ! 487: (interactive "r") ! 488: (scheme-do-zap-region start end (current-buffer))) ! 489: ! 490: (defun scheme-zap-expression (arg) ! 491: "Zap sexp before point into Scheme." ! 492: (interactive "P") ! 493: (scheme-do-zap-region ! 494: (let ((stab (syntax-table))) ! 495: (unwind-protect ! 496: (save-excursion ! 497: (set-syntax-table lisp-mode-syntax-table) ! 498: (forward-sexp -1) ! 499: (point)) ! 500: (set-syntax-table stab))) ! 501: (point) ! 502: (current-buffer) ! 503: t)) ! 504: ! 505: (defun scheme-zap-define (arg) ! 506: "Zap current definition into Scheme." ! 507: (interactive "P") ! 508: (let ((stab (syntax-table))) ! 509: (unwind-protect ! 510: (save-excursion ! 511: (set-syntax-table scheme-mode-syntax-table) ! 512: (if (not (= (point) (point-max))) (forward-char 1)) ! 513: (beginning-of-defun 1) ! 514: (let ((start (point))) ! 515: (forward-sexp 1) ! 516: (scheme-do-zap-region start ! 517: (point) ! 518: (current-buffer) ! 519: t))) ! 520: (set-syntax-table stab)))) ! 521: ! 522: (defun scheme-send-buffer (arg) ! 523: "Zap whole buffer and resume Scheme" ! 524: (interactive "P") ! 525: (scheme-do-zap-region (point-min) ! 526: (point-max) ! 527: (current-buffer)) ! 528: (resume-scheme)) ! 529: ! 530: (defun scheme-zap-define-and-resume (arg) ! 531: "Zap current definition and resume Scheme" ! 532: (interactive "P") ! 533: (scheme-zap-define arg) ! 534: (resume-scheme)) ! 535: ! 536: (defun defining-p () ! 537: (save-excursion ! 538: (let* ((here (point)) ! 539: (name (buffer-substring (progn (backward-sexp 1) (point)) here))) ! 540: (beginning-of-defun 1) ! 541: (if (char-equal (char-after (point)) ?\() ! 542: (progn (forward-char 1) ! 543: (let ((sub (substring (next-sexp-as-string) 0 3))) ! 544: (if (or (string-equal sub "def") (string-equal sub "DEF")) ! 545: (progn (forward-sexp 1) ! 546: (forward-word 1) ! 547: (backward-word 1) ! 548: (string-equal name ! 549: (next-sexp-as-string)))))))))) ! 550: ! 551: (defun find-scheme-definition (name) ! 552: "Find the definition of its argument in the current buffer" ! 553: (interactive "sFind Scheme definition of: ") ! 554: (beginning-of-buffer) ! 555: (let ((stop nil)) ! 556: (while (not stop) ! 557: (search-forward name) ! 558: (setq stop (defining-p))))) ! 559: ! 560: ;;; Autoloads from xscheme: ! 561: ! 562: (autoload 'scheme "xscheme" ! 563: "Run an inferior Scheme process reading a command line from the terminal." ! 564: t) ! 565: ! 566: (autoload 'run-scheme "xscheme" ! 567: "Run an inferior Scheme process." ! 568: t) ! 569: ! 570: (autoload 'scheme-send-definition "xscheme" ! 571: "Send the current definition to the Scheme process made by M-x run-scheme." ! 572: t) ! 573: ! 574: (autoload 'scheme-send-definition-and-go "xscheme" ! 575: "Send the current definition to the inferior Scheme, and switch to *scheme* buffer." ! 576: t)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.