[slime-cvs] CVS slime
heller
heller at common-lisp.net
Mon Feb 25 17:17:58 UTC 2008
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv31496
Modified Files:
ChangeLog swank-loader.lisp swank.asd swank.lisp
Log Message:
Make it easier to prepare core-files.
* swank-loader.lisp (init): Two new keyword args: :SETUP and
:LOAD-CONTRIBS. :SETUP=nil can be used to suppress init hooks and
loading user init files.
* swank.asd: Call swank-loader:init with :SETUP=nil.
* swank.lisp (init-global-stream-redirection): Guard against
redirecting already redirected streams.
--- /project/slime/cvsroot/slime/ChangeLog 2008/02/24 16:50:47 1.1305
+++ /project/slime/cvsroot/slime/ChangeLog 2008/02/25 17:17:56 1.1306
@@ -1,3 +1,16 @@
+2008-02-25 Helmut Eller <heller at common-lisp.net>
+
+ Make it easier to prepare core-files.
+
+ * swank-loader.lisp (init): Two new keyword args: :SETUP and
+ :LOAD-CONTRIBS. :SETUP=nil can be used to suppress init hooks and
+ loading user init files.
+
+ * swank.asd: Call swank-loader:init with :SETUP=nil.
+
+ * swank.lisp (init-global-stream-redirection): Guard against
+ redirecting already redirected streams.
+
2008-02-24 Helmut Eller <heller at common-lisp.net>
Work harder to avoid wrong guesses for slime-repl-set-package.
--- /project/slime/cvsroot/slime/swank-loader.lisp 2008/02/20 22:10:38 1.81
+++ /project/slime/cvsroot/slime/swank-loader.lisp 2008/02/25 17:17:56 1.82
@@ -20,8 +20,7 @@
(cl:defpackage :swank-loader
(:use :cl)
- (:export :load-swank
- :init
+ (:export :init
:*source-directory*
:*fasl-directory*))
@@ -32,21 +31,18 @@
:defaults (or *load-pathname* *default-pathname-defaults*))
"The directory where to look for the source.")
-(defparameter *sysdep-files*
- (append
- '()
- #+cmu '("swank-source-path-parser" "swank-source-file-cache" "swank-cmucl")
- #+scl '("swank-source-path-parser" "swank-source-file-cache" "swank-scl")
- #+sbcl '("swank-source-path-parser" "swank-source-file-cache"
- "swank-sbcl" "swank-gray")
- #+openmcl '("metering" "swank-openmcl" "swank-gray")
- #+lispworks '("swank-lispworks" "swank-gray")
- #+allegro '("swank-allegro" "swank-gray")
- #+clisp '("xref" "metering" "swank-clisp" "swank-gray")
- #+armedbear '("swank-abcl")
- #+cormanlisp '("swank-corman" "swank-gray")
- #+ecl '("swank-ecl" "swank-gray")
- ))
+(defparameter *sysdeps*
+ #+cmu '(swank-source-path-parser swank-source-file-cache swank-cmucl)
+ #+scl '(swank-source-path-parser swank-source-file-cache swank-scl)
+ #+sbcl '(swank-source-path-parser swank-source-file-cache
+ swank-sbcl swank-gray)
+ #+openmcl '(metering swank-openmcl swank-gray)
+ #+lispworks '(swank-lispworks swank-gray)
+ #+allegro '(swank-allegro swank-gray)
+ #+clisp '(xref metering swank-clisp swank-gray)
+ #+armedbear '(swank-abcl)
+ #+cormanlisp '(swank-corman swank-gray)
+ #+ecl '(swank-ecl swank-gray))
(defparameter *implementation-features*
'(:allegro :lispworks :sbcl :openmcl :cmu :clisp :ccl :corman :cormanlisp
@@ -183,12 +179,7 @@
:defaults src-dir))
names))
-(defun swank-src-files (src-dir)
- (src-files `("swank-backend" ,@*sysdep-files* "swank")
- src-dir))
-
-(defvar *fasl-directory* (default-fasl-dir)
- "The directory where fasl files should be placed.")
+(defvar *swank-files* `(swank-backend ,@*sysdep-files* swank))
(defvar *contribs* '(swank-c-p-c swank-arglists swank-fuzzy
swank-fancy-inspector
@@ -197,6 +188,9 @@
)
"List of names for contrib modules.")
+(defvar *fasl-directory* (default-fasl-dir)
+ "The directory where fasl files should be placed.")
+
(defun append-dir (absolute name)
(merge-pathnames
(make-pathname :directory `(:relative ,name) :defaults absolute)
@@ -207,11 +201,16 @@
(defun load-swank (&key (src-dir *source-directory*)
(fasl-dir *fasl-directory*))
- (compile-files (swank-src-files src-dir) fasl-dir t))
+ (compile-files (src-files *swank-files* src-dir) fasl-dir t))
(defun compile-contribs (&key (src-dir (contrib-dir *source-directory*))
- (fasl-dir (contrib-dir *fasl-directory*)))
- (compile-files (src-files *contribs* src-dir) fasl-dir nil))
+ (fasl-dir (contrib-dir *fasl-directory*))
+ load)
+ (compile-files (src-files *contribs* src-dir) fasl-dir load))
+
+(defun loadup ()
+ (load-swank)
+ (compile-contribs :load t))
(defun setup ()
(flet ((q (s) (read-from-string s)))
@@ -223,11 +222,14 @@
(list (contrib-dir *fasl-directory*)
(contrib-dir *source-directory*)))))
-(defun init (&key delete reload)
+(defun init (&key delete reload load-contribs (setup t))
(when (and delete (find-package :swank))
(mapc #'delete-package '(:swank :swank-io-package :swank-backend)))
(cond ((or (not (find-package :swank)) reload)
(load-swank))
(t
(warn "Not reloading SWANK. Package already exists.")))
- (setup))
+ (when load-contribs
+ (compile-contribs :load t))
+ (when setup
+ (setup)))
--- /project/slime/cvsroot/slime/swank.asd 2008/02/17 12:28:27 1.6
+++ /project/slime/cvsroot/slime/swank.asd 2008/02/25 17:17:56 1.7
@@ -37,7 +37,8 @@
(load (asdf::component-pathname f))
(funcall (read-from-string "swank-loader::init")
:reload (asdf::operation-forced o)
- :delete (asdf::operation-forced o)))
+ :delete (asdf::operation-forced o)
+ :setup nil))
(asdf:defsystem :swank
:default-component-class swank-loader-file
--- /project/slime/cvsroot/slime/swank.lisp 2008/02/24 16:49:49 1.536
+++ /project/slime/cvsroot/slime/swank.lisp 2008/02/25 17:17:56 1.537
@@ -587,9 +587,9 @@
(initialize-multiprocessing
(lambda ()
(spawn (lambda ()
- (loop do (ignore-errors (serve)) while dont-close))
- :name (concatenate 'string "Swank "
- (princ-to-string port))))))
+ (cond ((not dont-close) (serve))
+ (t (loop (ignore-errors (serve))))))
+ :name (cat "Swank " (princ-to-string port))))))
((:fd-handler :sigio)
(add-fd-handler socket (lambda () (serve))))
((nil) (loop do (serve) while dont-close)))
@@ -1210,7 +1210,8 @@
(defun init-global-stream-redirection ()
(when *globally-redirect-io*
- (mapc #'setup-stream-indirection
+ (assert (not *saved-global-streams*) () "Streams already redirected.")
+ (mapc #'setup-stream-indirection
(append *standard-output-streams*
*standard-input-streams*
*standard-io-streams*))))
More information about the slime-cvs
mailing list