1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
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::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)
|
