emacs/gambit.el

   1 ;;; -*- Mode:Emacs-Lisp -*-
   2 ;;; gambit.el --- Run Gambit in an [X]Emacs buffer
   3
   4 ;; Copyright (c) 1997-2004 Marc Feeley & Michael Sperber
   5
   6 ;; Authors: Marc Feeley <feeley@iro.umontreal.ca>
   7 ;;          Mike Sperber <sperber@informatik.uni-tuebingen.de>
   8 ;; Keywords: processes, lisp
   9
  10 ;; To use this package, make sure this file is accessible from your
  11 ;; load-path and that the following lines are in your ".emacs" file:
  12 ;;
  13 ;; (autoload 'gambit-inferior-mode "gambit" "Hook Gambit mode into cmuscheme.")
  14 ;; (autoload 'gambit-mode "gambit" "Hook Gambit mode into scheme.")
  15 ;; (add-hook 'inferior-scheme-mode-hook (function gambit-inferior-mode))
  16 ;; (add-hook 'scheme-mode-hook (function gambit-mode))
  17 ;; (setq scheme-program-name "gsi -:t")
  18 ;;
  19 ;; Alternatively, if you don't mind always loading this package,
  20 ;; you can simply add this line to your ".emacs" file:
  21 ;;
  22 ;; (require 'gambit)
  23 ;;
  24 ;; You can then start Gambit with "M-x run-scheme".
  25 ;;
  26 ;; When Gambit signals an error, Emacs will intercept the location
  27 ;; information in the error message and automatically open a buffer
  28 ;; highlighting the error.
  29 ;;
  30 ;; The continuation of the error can be inspected with the "C-c ["
  31 ;; (crawl towards older frames) and "C-c ]" (crawl towards newer
  32 ;; frames).  For each new frame visited, Emacs will highlight the
  33 ;; expression associated with the frame.
  34 ;;
  35 ;; "C-c c", "C-c s" and "C-c l" can be used to send the commands
  36 ;; ",c", ",s" and ",l" respectively to Gambit.  This is convenient for
  37 ;; single-stepping a program.
  38 ;;
  39 ;; "C-c _" can be used to delete the last popup window that was
  40 ;; created to highlight a Scheme expression.
  41
  42 ;;;----------------------------------------------------------------------------
  43
  44 ;; User overridable parameters.
  45
  46 (defvar scheme-program-name "gsi -:d-")
  47
  48 (defvar gambit-repl-command-prefix "\C-c"
  49   "Emacs keybinding prefix for Gambit REPL's commands.")
  50
  51 (defvar gambit-highlight-color "gold"
  52   "Color of the overlay for highlighting Scheme expressions.")
  53
  54 (defvar gambit-highlight-face
  55   (let ((face 'gambit-highlight-face))
  56     (condition-case nil
  57         (progn
  58           (make-face face)
  59           (if (x-display-color-p)
  60               (set-face-background face gambit-highlight-color)
  61               (progn
  62                 ;(make-face-bold face)
  63                 (set-face-underline-p face t))))
  64         (error (setq face nil)))
  65     face)
  66   "Face of overlay for highlighting Scheme expressions.")
  67
  68 (defvar gambit-new-window-height 6
  69   "Height of a window opened to highlight a Scheme expression.")
  70
  71 (defvar gambit-move-to-highlighted (not gambit-highlight-face)
  72   "Flag to move to window opened to highlight a Scheme expression.")
  73
  74 ;;;----------------------------------------------------------------------------
  75
  76 ;; These must be loaded first because we redefine some of the
  77 ;; functions they contain.
  78
  79 (require 'scheme)
  80 (require 'cmuscheme)
  81
  82 ;;;----------------------------------------------------------------------------
  83
  84 (defun gambit-indent-function (indent-point state)
  85   (let ((normal-indent (current-column)))
  86     (goto-char (1+ (elt state 1)))
  87     (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
  88     (if (and (elt state 2)
  89              (not (looking-at "\\sw\\|\\s_")))
  90         ;; car of form doesn't seem to be a a symbol
  91         (progn
  92           (if (not (> (save-excursion (forward-line 1) (point))
  93                       calculate-lisp-indent-last-sexp))
  94               (progn (goto-char calculate-lisp-indent-last-sexp)
  95                      (beginning-of-line)
  96                      (parse-partial-sexp (point)
  97                                          calculate-lisp-indent-last-sexp 0 t)))
  98           ;; Indent under the list or under the first sexp on the same
  99           ;; line as calculate-lisp-indent-last-sexp.  Note that first
 100           ;; thing on that line has to be complete sexp since we are
 101           ;; inside the innermost containing sexp.
 102           (backward-prefix-chars)
 103           (current-column))
 104       (let ((function (buffer-substring (point)
 105                                         (progn (forward-sexp 1) (point))))
 106             method)
 107         (setq method (or (gambit-indent-method function)
 108                          (get (intern-soft function) 'scheme-indent-function)
 109                          (get (intern-soft function) 'scheme-indent-hook)))
 110         (cond ((or (eq method 'defun)
 111                    (and (null method)
 112                         (> (length function) 3)
 113                         (string-match "\\`def" function)))
 114                (lisp-indent-defform state indent-point))
 115               ((integerp method)
 116                (lisp-indent-specform method state
 117                                      indent-point normal-indent))
 118               (method
 119                 (funcall method state indent-point normal-indent)))))))
 120
 121 (defun gambit-indent-method (function)
 122   (let ((method nil)
 123         (alist gambit-indent-regexp-alist))
 124     (while (and (not method) (not (null alist)))
 125       (let* ((regexp (car alist))
 126              (x (string-match (car regexp) function)))
 127         (if x
 128             (setq method (cdr regexp)))
 129         (setq alist (cdr alist))))
 130     method))
 131
 132 (set lisp-indent-function 'gambit-indent-function)
 133
 134 (defvar gambit-indent-regexp-alist
 135   '(
 136     ("^declare$"               . defun)
 137     ("^##declare$"             . defun)
 138     ("^##define"               . defun)
 139     ("^macro-check"            . defun)
 140     ("^macro-force-vars$"      . defun)
 141     ("^macro-number-dispatch$" . defun)
 142    ))
 143
 144 ;;;----------------------------------------------------------------------------
 145
 146 ;; Portable functions for FSF Emacs and Xemacs.
 147
 148 (defun window-top-edge (window)
 149   (if (fboundp 'window-edges)
 150       (car (cdr (window-edges window)))
 151       (car (cdr (window-pixel-edges window)))))
 152
 153 ;; Xemacs calls its overlays "extents", so we have to use them to emulate
 154 ;; overlays on Xemacs.  Some versions of Xemacs have the portability package
 155 ;; "overlays.el" for this, so we could simply do:
 156 ;;
 157 ;; (condition-case nil ; load "overlay.el" if we have it
 158 ;;     (require 'overlay)
 159 ;;   (error nil))
 160 ;;
 161 ;; Unfortunately some versions of Xemacs don't have this package so
 162 ;; we explicitly define an interface to extents.
 163
 164 (if (not (fboundp 'make-overlay))
 165     (defun make-overlay (start end)
 166       (make-extent start end)))
 167
 168 (if (not (fboundp 'overlay-put))
 169     (defun overlay-put (overlay prop val)
 170       (set-extent-property overlay prop val)))
 171
 172 (if (not (fboundp 'move-overlay))
 173     (defun move-overlay (overlay start end buffer)
 174       (set-extent-endpoints overlay start end buffer)))
 175
 176 ;;;----------------------------------------------------------------------------
 177
 178 ;; Redefine the function scheme-send-region from `cmuscheme' so
 179 ;; that we can keep track of all text sent to Gambit's stdin.
 180
 181 (defun scheme-send-region (start end)
 182   "Send the current region to the inferior Scheme process."
 183   (interactive "r")
 184   (scheme-send-string (buffer-substring start end)))
 185
 186 (defun scheme-send-string (str)
 187   "Send a string to the inferior Scheme process."
 188   (let* ((clean-str (gambit-string-terminate-with-newline str))
 189          (proc (scheme-proc))
 190          (pmark (process-mark proc))
 191          (buffer (get-buffer scheme-buffer))
 192          (old-buffer (current-buffer)))
 193     (set-buffer buffer)
 194     (goto-char pmark)
 195     (set-marker comint-last-input-start (point))
 196     (insert clean-str)
 197     (set-marker pmark (point))
 198     (gambit-input-sender proc clean-str)
 199     (set-buffer old-buffer)))
 200
 201 (defun gambit-input-sender (proc str)
 202   (let ((clean-str (gambit-string-terminate-with-newline str)))
 203     (gambit-register-input clean-str)
 204     (gambit-make-read-only (current-buffer) (point-max))
 205     (gambit-unhighlight)
 206     (comint-send-string proc clean-str)))
 207
 208 (defun gambit-register-input (str)
 209   (let ((marker (make-marker)))
 210     (set-marker marker comint-last-input-start)
 211     (setq gambit-input-line-marker-alist
 212           (cons (cons gambit-input-line-count
 213                       marker)
 214                 gambit-input-line-marker-alist))
 215     (setq gambit-input-line-count
 216           (+ gambit-input-line-count
 217              (gambit-string-count-lines str)))))
 218
 219 (defun gambit-make-read-only (buffer end)
 220   ' ; disable read-only interaction, cause it doesn't work!
 221   (progn
 222     (put-text-property 1 end 'front-sticky '(read-only) buffer)
 223     (put-text-property 1 end 'rear-nonsticky '(read-only) buffer)
 224     (put-text-property 1 end 'read-only t buffer)))
 225
 226 ;;;----------------------------------------------------------------------------
 227
 228 (defun gambit-load-file (file-name)
 229   "Load a Scheme file FILE-NAME into the inferior Scheme process."
 230   (interactive (comint-get-source "Load Scheme file: " scheme-prev-l/c-dir/file
 231                                   scheme-source-modes t)) ; T because LOAD
 232                                                           ; needs an exact name
 233   (comint-check-source file-name) ; Check to see if buffer needs saved.
 234   (setq scheme-prev-l/c-dir/file (cons (file-name-directory    file-name)
 235                                        (file-name-nondirectory file-name)))
 236   (scheme-send-string (concat "(load \"" file-name "\"\)\n")))
 237
 238 (defun gambit-compile-file (file-name)
 239   "Compile a Scheme file FILE-NAME in the inferior Scheme process."
 240   (interactive (comint-get-source "Compile Scheme file: "
 241                                   scheme-prev-l/c-dir/file
 242                                   scheme-source-modes
 243                                   nil)) ; NIL because COMPILE doesn't
 244                                         ; need an exact name.
 245   (comint-check-source file-name) ; Check to see if buffer needs saved.
 246   (setq scheme-prev-l/c-dir/file (cons (file-name-directory    file-name)
 247                                        (file-name-nondirectory file-name)))
 248   (scheme-send-string (concat "(compile-file \"" file-name "\"\)\n")))
 249
 250 ;;;----------------------------------------------------------------------------
 251
 252 ;; Buffer local variables of the Gambit inferior process(es).
 253
 254 (defvar gambit-input-line-count nil
 255   "Line number as seen by the Gambit process.")
 256
 257 (defvar gambit-input-line-marker-alist nil
 258   "Alist of line numbers of input blocks and markers.")
 259
 260 (defvar gambit-last-output-marker nil
 261   "Points to the last character output by the Gambit process.")
 262
 263 ;;;----------------------------------------------------------------------------
 264
 265 ;; Utilities
 266
 267 (defun gambit-string-count-lines (str)
 268   "Returns number of complete lines in string."
 269   (let ((n 0)
 270         (start 0))
 271     (while (string-match "\n" str start)
 272       (setq n (+ n 1))
 273       (setq start (match-end 0)))
 274     n))
 275
 276 (defun gambit-string-terminate-with-newline (str)
 277   "Adds a newline at end of string if it doesn't already have one."
 278   (let ((len (length str)))
 279     (if (or (= len 0)
 280             (not (equal (aref str (- len 1)) ?\n)))
 281         (concat str "\n")
 282         str)))
 283
 284 ;;;----------------------------------------------------------------------------
 285
 286 ;; Define keys for single stepping and continuation crawling.
 287
 288 (defun gambit-step-continuation ()
 289   (interactive)
 290   (scheme-send-string "#||#,s;"))
 291
 292 (defun gambit-leap-continuation ()
 293   (interactive)
 294   (scheme-send-string "#||#,l;"))
 295
 296 (defun gambit-continue ()
 297   (interactive)
 298   (scheme-send-string "#||#,c;"))
 299
 300 (defun gambit-environment ()
 301   (interactive)
 302   (scheme-send-string "#||#,e;"))
 303
 304 (defun gambit-backtrace ()
 305   (interactive)
 306   (scheme-send-string "#||#,b;"))
 307
 308 (defun gambit-crawl-backtrace-newer ()
 309   (interactive)
 310   (scheme-send-string "#||#,-;"))
 311
 312 (defun gambit-crawl-backtrace-older ()
 313   (interactive)
 314   (scheme-send-string "#||#,+;"))
 315
 316 (defun gambit-kill-last-popup ()
 317   (interactive)
 318   (let ((windows gambit-popups))
 319     (while (not (null windows))
 320       (let ((window (car windows)))
 321         (setq windows (cdr windows))
 322         (if (and window
 323                  (window-live-p window))
 324             (progn
 325               (setq gambit-popups windows)
 326               (setq windows nil)
 327               (delete-window window)))))))
 328
 329 (defun gambit-add-popup (popup)
 330   (setq gambit-popups
 331         (cons popup (gambit-gc-popups gambit-popups))))
 332
 333 (defun gambit-gc-popups (popups)
 334   (cond ((null popups)
 335          '())
 336         ((window-live-p (car popups))
 337          (cons (car popups) (gambit-gc-popups (cdr popups))))
 338         (t
 339          (gambit-gc-popups (cdr popups)))))
 340
 341 (defvar gambit-popups nil)
 342
 343 ;;;----------------------------------------------------------------------------
 344
 345 ;; Procedures to intercept and process the location information output
 346 ;; by Gambit.
 347
 348 (defun gambit-output-filter (str)
 349   (let* ((buffer
 350           (current-buffer))
 351          (output-marker
 352           (process-mark (get-buffer-process buffer)))
 353          (locat
 354           (if (string-match "\n" str) ; match only after end of line is seen
 355               (let* ((end
 356                       (save-excursion
 357                         (goto-char output-marker)
 358                         (beginning-of-line)
 359                         (point)))
 360                      (start
 361                       (save-excursion
 362                         (goto-char (+ gambit-last-output-marker 1))
 363                         (beginning-of-line)
 364                         (point))))
 365                 (gambit-extract-location
 366                  (buffer-substring start end)))
 367               nil)))
 368     (gambit-make-read-only buffer output-marker)
 369     (set-marker gambit-last-output-marker (- output-marker 1))
 370     (let* ((windows
 371             (gambit-windows-displaying-buffer buffer))
 372            (initially-selected-window
 373             (selected-window)))
 374       (if (not (null windows))
 375           (save-excursion
 376             (set-buffer buffer)
 377             (select-window (car windows))
 378             (goto-char output-marker)
 379             (if (not (pos-visible-in-window-p))
 380                 (recenter -1))
 381             (select-window initially-selected-window))))
 382     (if locat
 383         (gambit-highlight-location locat))))
 384
 385 (defun gambit-extract-location (str)
 386   (let ((location nil)
 387         (alist gambit-location-regexp-alist))
 388     (while (and (not location) (not (null alist)))
 389       (let* ((regexp (car alist))
 390              (x (string-match (car regexp) str)))
 391         (if x
 392             (let* ((pos1 (nth 1 regexp))
 393                    (pos2 (nth 2 regexp))
 394                    (pos3 (nth 3 regexp))
 395                    (name (substring str
 396                                     (match-beginning pos1)
 397                                     (match-end pos1)))
 398                    (line (substring str
 399                                     (match-beginning pos2)
 400                                     (match-end pos2)))
 401                    (column (substring str
 402                                       (match-beginning pos3)
 403                                       (match-end pos3))))
 404               (setq location (list (read name) (read line) (read column)))))
 405         (setq alist (cdr alist))))
 406     location))
 407
 408 (defvar gambit-location-regexp-alist
 409   '(("\\(\\\"\\(\\\\\\\\\\|\\\\\"\\|[^\\\"\n]\\)+\\\"\\)@\\([0-9]+\\)\\.\\([0-9]+\\)[^0-9]" 1 3 4)
 410     ("\\((console)\\)@\\([0-9]+\\)\\.\\([0-9]+\\)[^0-9]" 1 2 3)
 411     ("\\((stdin)\\)@\\([0-9]+\\)\\.\\([0-9]+\\)[^0-9]" 1 2 3)))
 412
 413 (defun gambit-closest-non-following (line alist)
 414   (let ((closest nil))
 415     (while (not (null alist))
 416       (let ((x (car alist)))
 417         (if (and (<= (car x) line)
 418                  (or (not closest)
 419                      (> (car x) (car closest))))
 420             (setq closest x))
 421         (setq alist (cdr alist))))
 422     closest))
 423
 424 (defun gambit-highlight-location (locat)
 425
 426   ; invariant: the current buffer is the Scheme buffer
 427
 428   (let ((name (car locat))
 429         (line (car (cdr locat)))
 430         (column (car (cdr (cdr locat)))))
 431     (cond ((or (equal name '(console))
 432                (equal name '(stdin)))
 433            (let ((closest
 434                   (gambit-closest-non-following
 435                    line
 436                    gambit-input-line-marker-alist)))
 437              (if closest
 438                  (let ((n (- line (car closest))))
 439                    (gambit-highlight-expression
 440                     (current-buffer)
 441                     (save-excursion
 442                       (goto-char (cdr closest))
 443                       (if (> n 0) (forward-line n))
 444                       (forward-char (- column 1))
 445                       (point)))))))
 446           ((stringp name)
 447            (let ((buffer (find-file-noselect name)))
 448              (if buffer
 449                  (gambit-highlight-expression
 450                   buffer
 451                   (save-excursion
 452                     (set-buffer buffer)
 453                     (goto-line line)
 454                     (forward-char (- column 1))
 455                     (point)))))))))
 456
 457 (defun gambit-highlight-expression (location-buffer pos)
 458
 459 "Highlight the expression at a specific location in a buffer.
 460
 461 The location buffer is the one that contains the location to
 462 highlight and `pos' points to the first character of the
 463 expression in the buffer.  If the location buffer is not visible
 464 then we must display it in a window.  We also have to make sure
 465 the highlighted expression is visible, which may require the
 466 window to be scrolled.
 467
 468 Our approach is simple: if the location buffer is not visible or
 469 it is the Scheme buffer and it is only displayed in the selected
 470 window, then we split one of the windows in 2 and use the bottom
 471 window to display the location buffer.  The window chosen is
 472 preferentially the topmost window displaying the Scheme buffer,
 473 otherwise it is the selected window.  Before we do the split, we
 474 enlarge the window if it is too small."
 475
 476   (let* ((location-windows
 477           (gambit-windows-displaying-buffer location-buffer))
 478          (initially-selected-window
 479           (selected-window)))
 480
 481     ; "location-windows" is the list of windows containing
 482     ; the location buffer.
 483
 484     (if (or (null location-windows)
 485             (and (eq location-buffer (get-buffer scheme-buffer))
 486                  (eq initially-selected-window (car location-windows))
 487                  (null (cdr location-windows))))
 488
 489         (let* ((scheme-windows
 490                 (gambit-windows-displaying-buffer (get-buffer scheme-buffer)))
 491                (window-to-split
 492                 (if (null scheme-windows)
 493                     initially-selected-window
 494                     (car scheme-windows)))
 495                (height
 496                 (window-height window-to-split)))
 497           (select-window window-to-split)
 498           (if (< height (* 2 gambit-new-window-height))
 499               (enlarge-window
 500                (- (* 2 gambit-new-window-height)
 501                   height)))
 502           (let ((bottom-window
 503                  (split-window
 504                   window-to-split
 505                   (- (window-height window-to-split)
 506                      gambit-new-window-height))))
 507             (gambit-add-popup bottom-window)
 508             (select-window bottom-window)
 509             (switch-to-buffer location-buffer)))
 510
 511         (select-window (car (reverse location-windows))))
 512
 513     ; Highlight the expression in the location buffer.
 514
 515     (save-excursion
 516       (set-buffer (window-buffer (selected-window)))
 517       (goto-char pos)
 518       (if (not (pos-visible-in-window-p))
 519           (recenter (- (/ (window-height) 2) 1)))
 520       (gambit-highlight-region
 521        location-buffer
 522        pos
 523        (progn
 524          (condition-case nil
 525            (forward-sexp) ; we assume this uses the same syntax as Gambit
 526            (error ; if forward-sexp fails with this condition name
 527             (forward-char 1)))
 528          (point)))
 529       (goto-char pos))
 530
 531     (if (not (eq initially-selected-window (selected-window)))
 532         (progn
 533           (goto-char pos)
 534           (if (not gambit-move-to-highlighted)
 535               (select-window initially-selected-window))))))
 536
 537 (defun gambit-windows-displaying-buffer (buffer)
 538   (let ((windows '()))
 539     (walk-windows (function
 540                    (lambda (w)
 541                      (if (eq buffer (window-buffer w))
 542                          (setq windows (cons w windows)))))
 543                   t
 544                   'visible)
 545     (sort windows
 546           (function
 547            (lambda (w1 w2)
 548              (< (window-top-edge w1)
 549                 (window-top-edge w2)))))))
 550
 551 (defvar gambit-highlight-overlay
 552   (let ((ovl (make-overlay (point-min) (point-min))))
 553     (overlay-put ovl 'face gambit-highlight-face)
 554     ovl)
 555   "Overlay for highlighting Scheme expressions.")
 556
 557 (defun gambit-highlight-region (buffer start end)
 558   (if gambit-highlight-overlay
 559       (move-overlay gambit-highlight-overlay start end buffer)))
 560
 561 (defun gambit-unhighlight ()
 562   (gambit-highlight-region (get-buffer scheme-buffer) 1 1))
 563
 564 ;;;----------------------------------------------------------------------------
 565
 566 (defun gambit-install-comment-syntax ()
 567   "Configure #| ... |# comments."
 568   ;; XEmacs 19 and beyond use 8-bit modify-syntax-entry flags.
 569   ;; Emacs 19 uses a 1-bit flag.  We will have to set up our
 570   ;; syntax tables differently to handle this.
 571   ;; Stolen from CC Mode.
 572   (let ((table (copy-syntax-table))
 573         entry)
 574     (modify-syntax-entry ?a ". 12345678" table)
 575     (cond
 576      ;; XEmacs 19, and beyond Emacs 19.34
 577      ((arrayp table)
 578       (setq entry (aref table ?a))
 579       ;; In Emacs, table entries are cons cells
 580       (if (consp entry) (setq entry (car entry))))
 581      ;; XEmacs 20
 582      ((fboundp 'get-char-table) (setq entry (get-char-table ?a table)))
 583      ;; before and including Emacs 19.34
 584      ((and (fboundp 'char-table-p)
 585            (char-table-p table))
 586       (setq entry (car (char-table-range table [?a]))))
 587      ;; incompatible
 588      (t (error "Gambit mode is incompatible with this version of Emacs")))
 589     (if (= (logand (lsh entry -16) 255) 255)
 590         (progn
 591           ;; XEmacs 19 & 20
 592           (modify-syntax-entry ?# "(#58" scheme-mode-syntax-table)
 593           (modify-syntax-entry ?| ". 67" scheme-mode-syntax-table))
 594       ;; Emacs 19 & 20
 595       (modify-syntax-entry ?# "_ 14" scheme-mode-syntax-table)
 596       (modify-syntax-entry ?| "\" 23" scheme-mode-syntax-table))))
 597
 598 (defun gambit-extend-mode-map (map)
 599   (define-key map [(f8)]  'gambit-continue)
 600   (define-key map [(f9)]  'gambit-crawl-backtrace-newer)
 601   (define-key map [(f10)] 'gambit-crawl-backtrace-older)
 602   (define-key map [(f11)] 'gambit-step-continuation)
 603   (define-key map [(f12)] 'gambit-leap-continuation)
 604
 605   (define-key map "\C-c\C-l" 'gambit-load-file)
 606   (define-key map "\C-c\C-k" 'gambit-compile-file)
 607
 608   (let ((prefix gambit-repl-command-prefix))
 609     (define-key map (concat prefix "c") 'gambit-continue)
 610     (define-key map (concat prefix "]") 'gambit-crawl-backtrace-newer)
 611     (define-key map (concat prefix "[") 'gambit-crawl-backtrace-older)
 612     (define-key map (concat prefix "s") 'gambit-step-continuation)
 613     (define-key map (concat prefix "l") 'gambit-leap-continuation)
 614     (define-key map (concat prefix "_") 'gambit-kill-last-popup)))
 615
 616 (defun gambit-inferior-mode ()
 617
 618   (gambit-install-comment-syntax)
 619   (gambit-extend-mode-map inferior-scheme-mode-map)
 620
 621   (make-local-variable 'gambit-input-line-count)
 622   (setq gambit-input-line-count 1)
 623
 624   (make-local-variable 'gambit-input-line-marker-alist)
 625   (setq gambit-input-line-marker-alist '())
 626
 627   (make-local-variable 'gambit-last-output-marker)
 628   (setq gambit-last-output-marker (make-marker))
 629   (set-marker gambit-last-output-marker 0)
 630
 631   (setq comint-input-sender (function gambit-input-sender))
 632
 633   (add-hook 'comint-output-filter-functions
 634             (function gambit-output-filter)
 635             t
 636             t)) ; hook is buffer-local
 637
 638 (defun gambit-mode ()
 639   (gambit-install-comment-syntax)
 640   (gambit-extend-mode-map scheme-mode-map))
 641
 642 ;;(autoload 'gambit-inferior-mode "gambit" "Hook Gambit mode into cmuscheme.")
 643 ;;(autoload 'gambit-mode "gambit" "Hook Gambit mode into scheme.")
 644 (add-hook 'inferior-scheme-mode-hook (function gambit-inferior-mode))
 645 (add-hook 'scheme-mode-hook (function gambit-mode))
 646
 647 (provide 'gambit)
 648
 649 ;;;----------------------------------------------------------------------------