home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / command-interface / emacs-support.scm < prev    next >
Encoding:
Text File  |  1994-09-27  |  4.4 KB  |  136 lines  |  [TEXT/CCL2]
  1. ;;; emacs-support.scm -- support for the emacs interface
  2. ;;;
  3. ;;; author :  Sandra Loosemore
  4. ;;; date   :  30 Jul 1993
  5. ;;;
  6.  
  7. ;;; The emacs interface is set up to allow the vanilla command interface
  8. ;;; to run in a listener window.  The hooks allow some additional
  9. ;;; messages to be sent to the emacs process.  And, the emacs interface
  10. ;;; sends messages back to the haskell process by using the Lisp escape
  11. ;;; feature of the vanilla command interface.
  12.  
  13. (define (emacs-enter-debugger-hook)
  14.   (emacs-send-status "debug"))
  15.  
  16. (define (emacs-exit-debugger-hook)
  17.   (emacs-send-status "busy"))
  18.  
  19. (define (emacs-input-hook)
  20.   (emacs-send-status "input")
  21.   (let ((result (read-line)))
  22.     (emacs-send-status "busy")
  23.     result))
  24.  
  25. (define (emacs-command-hook)
  26.   (emacs-send-status "ready")
  27.   (vanilla-prompt)
  28.   (peek-char)  ; wait for input to arrive
  29.   (emacs-send-status "busy")
  30.   (vanilla-read-and-execute-command))
  31.  
  32. (define (emacs-initialize-hook)
  33.   ;; Nothing special needs to be done here.
  34.   (vanilla-initialize-hook))
  35.  
  36. (define (emacs-compilation-error-hook)
  37.   (emacs-send-error))
  38.  
  39.  
  40.  
  41. ;;; Tell emacs to update the process status in the mode line.
  42.  
  43. (define (emacs-send-status status)
  44.   (format '#t "EMACS:~a~%" status)
  45.   (force-output))
  46.  
  47.  
  48. ;;; This tells emacs to display a message in the minibuffer area.
  49.  
  50. (define (emacs-send-message message)
  51.   (format '#t "EMACS:message ~a~%" message)
  52.   (force-output))
  53.  
  54.  
  55. ;;; Tell emacs there was a compilation error.
  56.  
  57. (define (emacs-send-error)
  58.   (format '#t "EMACS:error~%")
  59.   (force-output))
  60.  
  61.  
  62. ;;; Here are some extra functions that the emacs interface uses.
  63.  
  64. (define (emacs-send-printers)
  65.   (format '#t "EMACS:printers ~s~%" (stringify-syms (dynamic *printers*)))
  66.   (force-output))
  67.  
  68. (define (emacs-send-optimizers)
  69.   (format '#t "EMACS:optimizers ~s~%"
  70.       (stringify-syms (dynamic *compiled-code-optimizers*)))
  71.   (force-output))
  72.  
  73. (define (stringify-syms syms)
  74.   (map (lambda (s) (string-downcase (symbol->string s))) syms))
  75.  
  76. (define (emacs-set-printers printers)
  77.   (setf (dynamic *printers*) (set-printers printers '=))
  78.   (emacs-send-message "Setting printers ...done.")
  79.   )
  80.  
  81. (define (emacs-set-optimizers optimizers)
  82.   (setf (dynamic *compiled-code-optimizers*) (set-optimizers optimizers '=))
  83.   (emacs-send-message "Setting optimizers ...done.")
  84.   )
  85.  
  86. (define (emacs-eval exp extension-name extension module-name maybe-file)
  87.   (emacs-send-message (format '#f "Evaluating: ~a" exp))
  88.   (haskell-eval exp extension-name extension module-name maybe-file)
  89.   (setf *remembered-module* module-name)
  90.   (when maybe-file (setf *remembered-file* maybe-file))
  91.   (emacs-send-message (format '#f "Evaluating: ~a ...done." exp)))
  92.  
  93. (define (emacs-run exp extension-name extension module-name maybe-file)
  94.   (emacs-send-message (format '#f "Running: ~a" exp))
  95.   (haskell-run exp extension-name extension module-name maybe-file)
  96.   (setf *remembered-module* module-name)
  97.   (when maybe-file (setf *remembered-file* maybe-file))
  98.   (emacs-send-message (format '#f "Running: ~a ...done." exp)))
  99.  
  100. (define (emacs-report-type exp extension-name extension module-name maybe-file)
  101.   (emacs-send-message (format '#f "Type checking: ~a" exp))
  102.   (haskell-report-type exp extension-name extension module-name maybe-file)
  103.   (setf *remembered-module* module-name)
  104.   (when maybe-file (setf *remembered-file* maybe-file))
  105.   (emacs-send-message (format '#f "Type checking: ~a ...done." exp)))
  106.  
  107.  
  108. (define (emacs-run-file filename)
  109.   (emacs-send-message (format '#f "Running file: ~a" filename))
  110.   (vanilla-run-file filename)
  111.   (emacs-send-message (format '#f "Running file: ~a ...done." filename)))
  112.  
  113. (define (emacs-load-file filename)
  114.   (emacs-send-message (format '#f "Loading file: ~a" filename))
  115.   (vanilla-load-file filename)
  116.   (emacs-send-message (format '#f "Loading file: ~a ...done." filename)))
  117.  
  118. (define (emacs-compile-file filename)
  119.   (emacs-send-message (format '#f "Compiling file: ~a" filename))
  120.   (vanilla-compile-file filename)
  121.   (emacs-send-message (format '#f "Compiling file: ~a ...done." filename)))
  122.  
  123.  
  124. ;;; Call this function to enable the emacs interface.
  125.  
  126. (define (use-emacs-interface)
  127.   (setf *haskell-enter-debugger-hook* (function emacs-enter-debugger-hook))
  128.   (setf *haskell-exit-debugger-hook* (function emacs-exit-debugger-hook))
  129.   (setf *haskell-input-hook* (function emacs-input-hook))
  130.   (setf *haskell-command-hook* (function emacs-command-hook))
  131.   (setf *haskell-initialize-hook* (function emacs-initialize-hook))
  132.   (setf *haskell-compilation-error-hook*
  133.     (function emacs-compilation-error-hook))
  134.   (emacs-initialize-hook))
  135.  
  136.