[Rename `scratch' to `user', and use the existing command processor's user environment to initialize SLIME48's user environment.
Taylor R Campbell <campbell@mumble.net>**20070512224833] {
hunk ./general.scm 17
-    :PACKAGE (:NAME "(scratch)"
-              :PROMPT "(scratch)")
+    :PACKAGE (:NAME "(user)"
+              :PROMPT "(user)")
hunk ./interfaces.scm 15
-          swank-world-scratch-env
+          swank-world-user-env
hunk ./interfaces.scm 22
-          make-swank-scratch-package
+          make-swank-user-package
merger 0.0 (
hunk ./load.scm 124
-  (call-with-values       ;No RECEIVE in the exec language.
-      (lambda ()
-        (if single-session?
-            (values 'SLIME48-SESSION 'SPAWN-SLIME48-SESSION)
-            (values 'SLIME48-TCP-SERVER 'SPAWN-SLIME48-TCP-SERVER)))
-    (lambda (name spawner)
-      (in 'SLIME48
-          `(RUN (BEGIN (DEFINE SLIME48-WORLD (MAKE-SLIME48-WORLD))
-                       (DEFINE ,name
-                         (,spawner SLIME48-WORLD ,@port-opt))))))))
+  (in 'SLIME48
+      `(RUN
+        (BEGIN
+          ,@(cond (single-session?
+                   `((DEFINE SLIME48-WORLD (MAKE-SLIME48-WORLD))
+                     (DEFINE SLIME48-SESSION
+                       (SPAWN-SLIME48-SESSION SLIME48-WORLD))
+                     (SERVE-ONE-SLIME48-SESSION SLIME48-SESSION
+                                                ,@port-opt)))
+                  (else
+                   `((DEFINE SLIME48-WORLD (MAKE-SLIME48-WORLD))
+                     (DEFINE CLOSE-SLIME48
+                       (SPAWN-SLIME48-TCP-SERVER SLIME48-WORLD
+                                                 ,@port-opt)))))))))
hunk ./load.scm 131
-          `(RUN (BEGIN (DEFINE SLIME48-WORLD (MAKE-SLIME48-WORLD))
-                       (DEFINE ,name
-                         (,spawner SLIME48-WORLD ,@port-opt))))))))
+          `(RUN (BEGIN
+                  (DEFINE SLIME48-WORLD
+                    (MAKE-SLIME48-WORLD
+                     ;; This is an ugly hack to make SLIME48 start up
+                     ;; in the command processor's user environment.
+                     ',(user interaction-environment)))
+                  (DEFINE ,name
+                    (,spawner SLIME48-WORLD ,@port-opt))))))))
)
merger 0.0 (
hunk ./session.scm 592
-  (let* ((top-dynamic-env
-          (with-restarter-invoker-hook swank-restarter-invoker-hook
-            (lambda ()
-              (with-interaction-environment
-                  (swank-world-scratch-env
-                   (swank-session-world session))
-                get-dynamic-env))))
-         (thread
-          (spawn (lambda ()
-                   (dynamic-wind
-                     top-winder
-                     (lambda ()
-                       (with-handler
-                           (lambda (c punt)
-                             (swank-condition-handler c punt))
-                         (lambda ()
-                           (set-swank-session-top-dynamic-env!
-                            session
-                            top-dynamic-env)
-                           (push-top-level session))))
-                     top-unwinder))
-                 `(swank-session-scheduler
-                   ,(swank-session-id session)))))
-    (set-swank-session-scheduler-thread! session thread)))
+  (set-swank-session-top-dynamic-env!
+   session
+   (with-restarter-invoker-hook
+       (make-swank-restarter-invoker-hook session)
+     (lambda ()
+       (with-interaction-environment (swank-world-scratch-env
+                                      (swank-session-world session))
+         (lambda ()
+           (with-swank-session session
+             get-dynamic-env))))))
+  (set-swank-session-scheduler-thread!
+   session
+   (spawn (lambda ()
+            (with-swank-session session
+              (lambda ()
+                (dynamic-wind top-winder
+                              (lambda () (push-top-level session))
+                              top-unwinder))))
+          `(swank-session-scheduler ,(swank-session-id session)))))
+
+(define $session (make-fluid #f))
+
+(define (with-swank-session session thunk)
+  (let-fluid $session session thunk))
+
+(define (current-swank-session)
+  (fluid $session))
+
+(define (current-swank-world)
+  (swank-session-world (current-swank-session)))
hunk ./session.scm 596
-                  (swank-world-scratch-env
+                  (swank-world-user-env
)
hunk ./slime48.el 75
-(defslime-repl-shortcut nil ("scratch")
+(defslime-repl-shortcut nil ("user")
hunk ./slime48.el 78
-              (slime-repl-set-package "(scratch)")))
-  (:one-liner "Change to the scratch package."))
+              (slime-repl-set-package "(user)")))
+  (:one-liner "Change to the user package."))
merger 0.0 (
hunk ./top.scm 68
+(define (slime48-secret-key)
+  (call-with-current-continuation
+    (lambda (abort)
+      (with-handler (lambda (condition propagate)
+                      (if (error? condition)
+                          (abort #f)
+                          (propagate)))
+        (lambda ()
+          (call-with-input-file "~/.slime-secret" read-line))))))
+
hunk ./top.scm 68
-(define (make-slime48-world)
-  (make-swank-world (make-swank-scratch-package (list scheme)
-                                                (list scheme))
+(define (make-slime48-world user-environment)
+  (make-swank-world user-environment
)
hunk ./world.scm 12
-  (make-swank-world scratch-env         ; user scratch environment
+  (make-swank-world user-env            ; user scratch environment
hunk ./world.scm 35
-  (append '((scratch) (config) (swank-rpc))
+  (append '((user) (config) (swank-rpc))
hunk ./world.scm 46
-           ((scratch)   (swank-world-scratch-env world))
+           ((user)      (swank-world-user-env    world))
hunk ./world.scm 59
-(define (make-swank-scratch-package opens tower-opens)
+(define (make-swank-user-package opens tower-opens)
hunk ./world.scm 63
-                       '(SCRATCH)))
+                       '(USER)))
}
