home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Utility Spectacular / Developer / macgambit-20-compiler-src-p2 / Interp⁄Comp (.scm) / mac_toplevel.scm < prev    next >
Encoding:
Text File  |  1994-07-26  |  2.8 KB  |  77 lines  |  [TEXT/gamI]
  1. (##declare
  2.   (multilisp)
  3.   (extended-bindings)
  4.   (not safe)
  5.   (not autotouch)
  6.   (block)
  7.   (fixnum))
  8.  
  9. ;------------------------------------------------------------------------------
  10.  
  11. (let ((mh (mac#getmenu 134)))
  12.   (if (##not (##fixnum.= mh 0))
  13.     (begin
  14.       (if (##not (##procedure? c#cf)) (mac#disableitem mh 2))
  15.       (mac#insertmenu mh 0)
  16.       (mac#drawmenubar)
  17.       (set! mac#menuselection
  18.         (lambda (selection)
  19.           (let ((menu (mac#getmhandle (##fixnum.ash selection -16)))
  20.                 (item (##fixnum.logand selection 65535)))
  21.             (if (##fixnum.= menu mh)
  22.               (cond ((##fixnum.= item 1)
  23.                      (let ((filename (mac#sfgetfile "Select file to load" "TEXTgamO")))
  24.                        (if filename
  25.                          (begin
  26.                            (##display "Loading " ##stdout #f)
  27.                            (##write filename ##stdout #f)
  28.                            (##newline ##stdout)
  29.                            (##load filename #f)))))
  30.                     ((##fixnum.= item 2)
  31.                      (let ((filename (mac#sfgetfile "Select file to compile" "TEXT")))
  32.                        (if filename
  33.                          (begin
  34.                            (##display "Compiling " ##stdout #f)
  35.                            (##write filename ##stdout #f)
  36.                            (##newline ##stdout)
  37.                            (c#cf filename 'm68000)))))))
  38.             (mac#hilitemenu 0)
  39.             ##unprint-object))))))
  40.  
  41. (set! c#pinpoint-error
  42.   (lambda (filename line char)
  43.     (mac#sysbeep 10)
  44.     (mac#edit filename line char)
  45.     #t))
  46.  
  47. ;------------------------------------------------------------------------------
  48.  
  49. (##display "MacGambit (v2.0)" ##stdout #f)
  50. (##newline ##stdout)
  51.  
  52. (let* ((repl-info (##make-vector 4 #f))
  53.        (dyn-bindings (##list (##cons '##REPL-INFO repl-info))))
  54.   (##call-with-current-continuation
  55.     (lambda (abort)
  56.       (##vector-set! repl-info 0 ##stdin)
  57.       (##vector-set! repl-info 1 ##stdout)
  58.       (##vector-set! repl-info 2 0)
  59.       (##vector-set! repl-info 3 (##cons abort '()))
  60.       (##dynamic-bind
  61.         dyn-bindings
  62.         (lambda ()
  63.           (let ((init (##open-input-file "init.scm")))
  64.             (if init (begin (##close-port init) (##load "init.scm" #f))
  65.               (let ((x (##vector-ref ##argv 0)))
  66.                 (let loop ((i (##string-length x)))
  67.                   (if (##fixnum.< 0 i)
  68.                     (if (##not (##char=? (##string-ref x (##fixnum.- i 1)) #\:))
  69.                       (loop (##fixnum.- i 1))
  70.                       (let ((s (##string-append (##substring x 0 i) "init.scm")))
  71.                         (let ((init (##open-input-file s)))
  72.                           (if init (begin (##close-port init) (##load s #f))))))))))))))))
  73.  
  74. (##repl)
  75.  
  76. ;------------------------------------------------------------------------------
  77.