[slime-cvs] CVS slime

heller heller at common-lisp.net
Tue Sep 4 10:32:07 UTC 2007


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

Modified Files:
	ChangeLog slime.el swank-backend.lisp swank-loader.lisp 
	swank.lisp 
Log Message:
Move asdf support to contrib.

* swank-backend.lisp (operate-on-system): Moved to
swank-asdf.lisp. It wasn't specialized in any backend.

* swank.lisp (operate-on-system-for-emacs)
(list-all-systems-known-to-asdf, list-asdf-systems): Moved to
swank-asdf.lisp.

* slime.el: Move asdf commands to contrib slime-adsf.el.

* swank-loader.lisp: Load swank-asdf if ASDF is in
*FEATURES*. Also add the contrib source directory to
swank::*load-path*.



--- /project/slime/cvsroot/slime/ChangeLog	2007/09/04 10:16:40	1.1199
+++ /project/slime/cvsroot/slime/ChangeLog	2007/09/04 10:32:04	1.1200
@@ -1,5 +1,22 @@
 2007-09-04  Helmut Eller  <heller at common-lisp.net>
 
+	Move asdf support to contrib.
+
+	* swank-backend.lisp (operate-on-system): Moved to
+	swank-asdf.lisp. It wasn't specialized in any backend.
+
+	* swank.lisp (operate-on-system-for-emacs)
+	(list-all-systems-known-to-asdf, list-asdf-systems): Moved to
+	swank-asdf.lisp.
+
+	* slime.el: Move asdf commands to contrib slime-adsf.el.
+
+	* swank-loader.lisp: Load swank-asdf if ASDF is in
+	*FEATURES*. Also add the contrib source directory to
+	swank::*load-path*.
+
+2007-09-04  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el: Move tramp support to contrib.
 
 2007-09-04  Helmut Eller  <heller at common-lisp.net>
--- /project/slime/cvsroot/slime/slime.el	2007/09/04 10:16:40	1.848
+++ /project/slime/cvsroot/slime/slime.el	2007/09/04 10:32:04	1.849
@@ -727,7 +727,6 @@
        [ "Compile/Load File"       slime-compile-and-load-file ,C ]
        [ "Compile File"            slime-compile-file ,C ]
        [ "Compile Region"          slime-compile-region ,C ]
-       [ "Compile System"          slime-load-system ,C ]
        "--"
        [ "Next Note"               slime-next-note t ]
        [ "Previous Note"           slime-previous-note t ]
@@ -3891,43 +3890,6 @@
                (slime-make-compilation-finished-continuation (current-buffer)))))
   (:one-liner "Compile (if neccessary) and load a lisp file."))
 
-(defslime-repl-shortcut slime-repl-load/force-system ("force-load-system")
-  (:handler (lambda ()
-              (interactive)
-              (slime-oos (slime-read-system-name) "LOAD-OP" :force t)))
-  (:one-liner "Recompile and load an ASDF system."))
-
-(defslime-repl-shortcut slime-repl-load-system ("load-system")
-  (:handler (lambda ()
-              (interactive)
-              (slime-oos (slime-read-system-name) "LOAD-OP")))
-  (:one-liner "Compile (as needed) and load an ASDF system."))
-
-(defslime-repl-shortcut slime-repl-test/force-system ("force-test-system")
-  (:handler (lambda ()
-              (interactive)
-              (slime-oos (slime-read-system-name) "TEST-OP" :force t)))
-  (:one-liner "Compile (as needed) and force test an ASDF system."))
-
-(defslime-repl-shortcut slime-repl-test-system ("test-system")
-  (:handler (lambda ()
-              (interactive)
-              (slime-oos (slime-read-system-name) "TEST-OP")))
-  (:one-liner "Compile (as needed) and test an ASDF system."))
-
-(defslime-repl-shortcut slime-repl-compile-system ("compile-system")
-  (:handler (lambda ()
-              (interactive)
-              (slime-oos (slime-read-system-name) "COMPILE-OP")))
-  (:one-liner "Compile (but not load) an ASDF system."))
-
-(defslime-repl-shortcut slime-repl-compile/force-system 
-  ("force-compile-system")  
-  (:handler (lambda ()
-              (interactive)
-              (slime-oos (slime-read-system-name) "COMPILE-OP" :force t)))
-  (:one-liner "Recompile (but not load) an ASDF system."))
-
 (defslime-repl-shortcut nil  ("restart-inferior-lisp")
   (:handler 'slime-restart-inferior-lisp)
   (:one-liner "Restart *inferior-lisp* and reconnect SLIME."))
@@ -4027,52 +3989,6 @@
      (slime-make-compilation-finished-continuation (current-buffer) snapshot))
     (message "Compiling %s.." lisp-filename)))
 
-(defun slime-find-asd (system-names)
-  "Tries to find an ASDF system definition in the default
-directory or in the directory belonging to the current buffer and
-returns it if it's in `system-names'."
-  (let* ((asdf-systems-in-directory
-           (mapcar #'file-name-sans-extension
-                   (directory-files
-                    (file-name-directory (or default-directory
-                                             (buffer-file-name)))
-                    nil "\.asd$"))))
-    (loop for system in asdf-systems-in-directory
-          for candidate = (file-name-sans-extension system)
-          when (find candidate system-names :test #'string-equal)
-            do (return candidate))))
-
-(defun slime-load-system (&optional system)
-  "Compile and load an ASDF system.  
-
-Default system name is taken from first file matching *.asd in current
-buffer's working directory"
-  (interactive (list (slime-read-system-name)))
-  (slime-oos system "LOAD-OP"))
-
-(defvar slime-system-history nil
-  "History list for ASDF system names.")
-
-(defun slime-read-system-name (&optional prompt initial-value)
-  "Read a system name from the minibuffer, prompting with PROMPT."
-  (setq prompt (or prompt "System: "))
-  (let* ((completion-ignore-case nil)
-         (system-names (slime-eval `(swank:list-asdf-systems)))
-         (alist (slime-bogus-completion-alist system-names)))
-    (completing-read prompt alist nil nil
-                     (or initial-value (slime-find-asd system-names) "")
-                     'slime-system-history)))
-
-(defun slime-oos (system operation &rest keyword-args)
-  (slime-save-some-lisp-buffers)
-  (slime-display-output-buffer)
-  (message "Performing ASDF %S%s on system %S"
-           operation (if keyword-args (format " %S" keyword-args) "")
-           system)
-  (slime-eval-async
-   `(swank:operate-on-system-for-emacs ,system ,operation , at keyword-args)
-   (slime-make-compilation-finished-continuation (current-buffer))))
-
 (defun slime-compile-defun ()
   "Compile the current toplevel form."
   (interactive)
--- /project/slime/cvsroot/slime/swank-backend.lisp	2007/09/04 09:49:09	1.123
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2007/09/04 10:32:05	1.124
@@ -19,6 +19,7 @@
            #:short-message
            #:condition
            #:severity
+           #:with-compilation-hooks
            #:location
            #:location-p
            #:location-buffer
@@ -345,20 +346,6 @@
 rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
 source information.")
 
-(definterface operate-on-system (system-name operation-name &rest keyword-args)
-  "Perform OPERATION-NAME on SYSTEM-NAME using ASDF.
-The KEYWORD-ARGS are passed on to the operation.
-Example:
-\(operate-on-system \"SWANK\" \"COMPILE-OP\" :force t)"
-  (unless (member :asdf *features*)
-    (error "ASDF is not loaded."))
-  (with-compilation-hooks ()
-    (let ((operate (find-symbol (symbol-name '#:operate) :asdf))
-          (operation (find-symbol operation-name :asdf)))
-      (when (null operation)
-        (error "Couldn't find ASDF operation ~S" operation-name))
-      (apply operate operation system-name keyword-args))))
-
 (definterface swank-compile-file (filename load-p external-format)
    "Compile FILENAME signalling COMPILE-CONDITIONs.
 If LOAD-P is true, load the file after compilation.
--- /project/slime/cvsroot/slime/swank-loader.lisp	2007/08/31 11:48:23	1.70
+++ /project/slime/cvsroot/slime/swank-loader.lisp	2007/09/04 10:32:05	1.71
@@ -200,7 +200,9 @@
 
 (defvar *contribs* '(swank-c-p-c swank-arglists swank-fuzzy
                      swank-fancy-inspector
-                     swank-presentations swank-presentation-streams)
+                     swank-presentations swank-presentation-streams
+                     #+asdf swank-asdf
+                     )
   "List of names for contrib modules.")
 
 (defun append-dir (absolute name)
@@ -208,8 +210,11 @@
    (make-pathname :directory `(:relative ,name) :defaults absolute)
    absolute))
 
+(defun contrib-src-dir (src-dir)
+  (append-dir src-dir "contrib"))
+
 (defun contrib-source-files (src-dir)
-  (source-files *contribs* (append-dir src-dir "contrib")))
+  (source-files *contribs* (contrib-src-dir src-dir)))
 
 (defun load-swank (&key
                    (source-directory *source-directory*)
@@ -219,12 +224,14 @@
   (compile-files-if-needed-serially (swank-source-files source-directory)
                                     fasl-directory t)
   (compile-files-if-needed-serially (contrib-source-files source-directory)
-                                    contrib-fasl-directory nil)
-  (set (read-from-string "swank::*swank-wire-protocol-version*")
-       (slime-version-string))
-  (funcall (intern (string :warn-unimplemented-interfaces) :swank-backend))
-  (load-site-init-file source-directory)
-  (load-user-init-file)
-  (funcall (intern (string :run-after-init-hook) :swank)))
+                                    contrib-fasl-directory nil))
 
 (load-swank)
+
+(setq swank::*swank-wire-protocol-version* (slime-version-string))
+(setq swank::*load-path* 
+      (append swank::*load-path* (list (contrib-src-dir *source-directory*))))
+(swank-backend::warn-unimplemented-interfaces)
+(load-site-init-file *source-directory*)
+(load-user-init-file)
+(swank:run-after-init-hook)
--- /project/slime/cvsroot/slime/swank.lisp	2007/09/04 09:49:09	1.508
+++ /project/slime/cvsroot/slime/swank.lisp	2007/09/04 10:32:05	1.509
@@ -2223,50 +2223,6 @@
        (let ((*compile-print* nil) (*compile-verbose* t))
          (swank-compile-string string :buffer buffer :position position 
                                :directory directory))))))
-
-(defslimefun operate-on-system-for-emacs (system-name operation &rest keywords)
-  "Compile and load SYSTEM using ASDF.
-Record compiler notes signalled as `compiler-condition's."
-  (swank-compiler 
-   (lambda ()
-     (apply #'operate-on-system system-name operation keywords))))
-
-(defun asdf-central-registry ()
-  (when (find-package :asdf)
-    (symbol-value (find-symbol (string :*central-registry*) :asdf))))
-
-(defslimefun list-all-systems-in-central-registry ()
-  "Returns a list of all systems in ASDF's central registry."
-  (mapcar #'pathname-name
-          (delete-duplicates
-           (loop for dir in (asdf-central-registry)
-                 for defaults = (eval dir)
-                 when defaults
-                   nconc (mapcar #'file-namestring
-                                   (directory
-                                     (make-pathname :defaults defaults
-                                          :version :newest
-                                          :type "asd"
-                                          :name :wild
-                                          :case :local))))
-           :test #'string=)))
-
-(defslimefun list-all-systems-known-to-asdf ()
-  "Returns a list of all systems ASDF knows already."
-  (unless (find-package :asdf)
-    (error "ASDF not loaded"))
-  ;; ugh, yeah, it's unexported - but do we really expect this to
-  ;; change anytime soon?
-  (loop for name being the hash-keys of (read-from-string 
-                                         "#.asdf::*defined-systems*")
-        collect name))
-
-(defslimefun list-asdf-systems ()
-  "Returns the systems in ASDF's central registry and those which ASDF
-already knows."
-  (nunion (list-all-systems-known-to-asdf)
-          (list-all-systems-in-central-registry)
-          :test #'string=))
   
 (defun file-newer-p (new-file old-file)
   "Returns true if NEW-FILE is newer than OLD-FILE."




More information about the slime-cvs mailing list