[slime-cvs] CVS slime

[heller]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv13763

Modified Files:
	slime.el 
Log Message:
Introduce a slime-start-and-init function.

* slime.el (slime-start-and-load, slime-lisp-options): New
functions.
(slime-start-and-load): Use it.



--- /project/slime/cvsroot/slime/slime.el	2007/09/19 11:26:48	1.866
+++ /project/slime/cvsroot/slime/slime.el	2007/09/19 11:29:49	1.867
@@ -1321,8 +1321,8 @@
   (interactive)
   (let ((inferior-lisp-program (or command inferior-lisp-program))
         (slime-net-coding-system (or coding-system slime-net-coding-system)))
-    (apply #'slime-start (slime-read-interactive-args))))
-
+    (slime-start* (slime-read-interactive-args))))
+                                                  
 (defun slime-read-interactive-args ()
   "Return the list of args which should be passed to `slime-start'.
 
@@ -1342,14 +1342,7 @@
 - If the prefix-arg is positive, read the command to start the
   process."
   (let ((table slime-lisp-implementations))
-    (cond ((not current-prefix-arg)
-           (cond (table 
-                  (slime-lookup-lisp-implementation 
-                   table (or slime-default-lisp (car (first table)))))
-                 (t
-                  (destructuring-bind (program &rest args) 
-                      (split-string inferior-lisp-program)
-                    (list :program program :program-args args)))))
+    (cond ((not current-prefix-arg) (slime-lisp-options))
           ((eq current-prefix-arg '-)
            (let ((key (completing-read 
                        "Lisp name: " (mapcar (lambda (x) 
@@ -1370,6 +1363,16 @@
                (list :program program :program-args program-args
                      :coding-system coding-system)))))))
 
+(defun slime-lisp-options (&optional name)
+  (let ((table slime-lisp-implementations))
+    (assert (or (not name) table))
+    (cond (table (slime-lookup-lisp-implementation slime-lisp-implementations 
+                                                   (or name slime-default-lisp
+                                                       (car (car table)))))
+          (t (destructuring-bind (program &rest args)
+                 (split-string inferior-lisp-program)
+               (list :program program :program-args args))))))
+
 (defun slime-lookup-lisp-implementation (table name)
   (destructuring-bind (name (prog &rest args) &rest keys) (assoc name table)
     (list* :name name :program prog :program-args args keys)))
@@ -1392,6 +1395,9 @@
       (slime-inferior-connect proc args)
       (pop-to-buffer (process-buffer proc)))))
 
+(defun slime-start* (options)
+  (apply #'slime-start options))
+
 (defun slime-connect (host port &optional coding-system)
   "Connect to a running Swank server."
   (interactive (list (read-from-minibuffer "Host: " slime-lisp-host)
@@ -1414,12 +1420,15 @@
   (cond ((slime-connected-p)
          (slime-load-file-set-package filename package))
         (t
-         (lexical-let ((hook nil) (package package) (filename filename))
-           (setq hook (lambda ()
-                        (remove-hook 'slime-connected-hook hook)
-                        (slime-load-file-set-package filename package)))
-           (add-hook 'slime-connected-hook hook)
-           (slime)))))
+         (slime-start-and-init (slime-lisp-options)
+                               #'slime-start-and-load filename package))))
+
+(defun slime-start-and-init (options fun &rest args)
+  (lexical-let* ((fun fun) (args args)
+                 (rest (plist-get options :init-function))
+                 (init (cond (rest (lambda () (funcall rest) (apply fun args)))
+                             (t (lambda () (apply fun args))))))
+    (slime-start* (plist-put (copy-list options) :init-function init))))
 
 (defun slime-load-file-set-package (filename package)
   (let ((filename (slime-to-lisp-filename filename)))