Add support for Scheme and Racket language.

sources_non_forked/slimv/slime/contrib/swank-snapshot.lisp

@@ -0,0 +1,67 @@
+
+(defpackage swank-snapshot
+  (:use cl)
+  (:export restore-snapshot save-snapshot background-save-snapshot)
+  (:import-from swank defslimefun))
+(in-package swank-snapshot)
+
+(defslimefun save-snapshot (image-file)
+  (swank/backend:save-image image-file 
+			    (let ((c swank::*emacs-connection*))
+			      (lambda () (resurrect c))))
+  (format nil "Dumped lisp to ~A" image-file))
+
+(defslimefun restore-snapshot (image-file)
+  (let* ((conn swank::*emacs-connection*)
+	 (stream (swank::connection.socket-io conn))
+	 (clone (swank/backend:dup (swank/backend:socket-fd stream)))
+	 (style (swank::connection.communication-style conn))
+	 (repl (if (swank::connection.user-io conn) t))
+	 (args (list "--swank-fd" (format nil "~d" clone)
+		     "--swank-style" (format nil "~s" style)
+		     "--swank-repl" (format nil "~s" repl))))
+    (swank::close-connection conn nil nil)
+    (swank/backend:exec-image image-file args)))
+
+(defslimefun background-save-snapshot (image-file)
+  (let ((connection swank::*emacs-connection*))
+    (flet ((complete (success)
+	     (let ((swank::*emacs-connection* connection))
+	       (swank::background-message
+		"Dumping lisp image ~A ~:[failed!~;succeeded.~]" 
+		image-file success)))
+	   (awaken ()
+	     (resurrect connection)))
+      (swank/backend:background-save-image image-file
+					   :restart-function #'awaken
+					   :completion-function #'complete)
+      (format nil "Started dumping lisp to ~A..." image-file))))
+
+(in-package :swank)
+
+(defun swank-snapshot::resurrect (old-connection)
+  (setq *log-output* nil)
+  (init-log-output)
+  (clear-event-history)
+  (setq *connections* (delete old-connection *connections*))
+  (format *error-output* "args: ~s~%" (command-line-args))
+  (let* ((fd (read-command-line-arg "--swank-fd"))
+	 (style (read-command-line-arg "--swank-style"))
+	 (repl (read-command-line-arg "--swank-repl"))
+	 (* (format *error-output* "fd=~s style=~s~%" fd style))
+	 (stream (make-fd-stream fd nil))
+	 (connection (make-connection nil stream style)))
+    (let ((*emacs-connection* connection))
+      (when repl (swank-repl:create-repl nil))
+      (background-message "~A" "Lisp image restored"))
+    (serve-requests connection)
+    (simple-repl)))
+
+(defun read-command-line-arg (name)
+  (let* ((args (command-line-args))
+	 (pos (position name args :test #'equal)))
+    (read-from-string (elt args (1+ pos)))))
+
+(in-package :swank-snapshot)
+
+(provide :swank-snapshot)