[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