[slime-cvs] CVS slime/contrib
heller
heller at common-lisp.net
Tue Sep 4 10:32:07 UTC 2007
Update of /project/slime/cvsroot/slime/contrib
In directory clnet:/tmp/cvs-serv30531/contrib
Modified Files:
ChangeLog
Added Files:
slime-asdf.el swank-asdf.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/contrib/ChangeLog 2007/09/04 10:16:43 1.29
+++ /project/slime/cvsroot/slime/contrib/ChangeLog 2007/09/04 10:32:07 1.30
@@ -1,5 +1,17 @@
2007-09-04 Helmut Eller <heller at common-lisp.net>
+ Move asdf support to contrib:
+
+ * slime-asdf.el: New file.
+
+ * swank-asdf.lisp: New file
+ (operate-on-system, asdf-central-registry)
+ (list-all-systems-known-to-asdf): Use the asdf package in the
+ source code, i.e. write asdf:operate instead of
+ (find-symbol "OPERATE" "ASDF").
+
+2007-09-04 Helmut Eller <heller at common-lisp.net>
+
* slime-tramp.el: New file.
* slime-banner.el: New file.
* inferior-slime.el: New file.
--- /project/slime/cvsroot/slime/contrib/slime-asdf.el 2007/09/04 10:32:07 NONE
+++ /project/slime/cvsroot/slime/contrib/slime-asdf.el 2007/09/04 10:32:07 1.1
;;; slime-asdf.el -- ASDF support
;;
;; Authors: Daniel Barlow <dan at telent.net>
;; Marco Baringer <mb at bese.it>
;; Edi Weitz <edi at agharta.de>
;; and others
;; License: GNU GPL (same license as Emacs)
;;
;;; Installation:
;;
;; Add something like this to your .emacs:
;;
;; (add-to-list 'load-path ".../slime/contrib")
;; (add-hook 'slime-load-hook (lambda () (require 'slime-asdf)))
;;
;; NOTE: `system-name' is a predefined variable in Emacs. Try to
;; avoid it as local variable name.
(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-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-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))))
(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."))
(defun slime-asdf-on-connect ()
(slime-eval-async '(swank:swank-require :swank-asdf)))
(add-hook 'slime-connected-hook 'slime-asdf-on-connect)
(provide 'slime-asdf)
--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp 2007/09/04 10:32:07 NONE
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp 2007/09/04 10:32:07 1.1
;;; swank-asdf.el -- ASDF support
;;
;; Authors: Daniel Barlow <dan at telent.net>
;; Marco Baringer <mb at bese.it>
;; Edi Weitz <edi at agharta.de>
;; and others
;; License: Public Domain
;;
(in-package :swank)
(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 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)"
(with-compilation-hooks ()
(let ((operation (find-symbol operation-name :asdf)))
(when (null operation)
(error "Couldn't find ASDF operation ~S" operation-name))
(apply #'asdf:operate operation system-name keyword-args))))
(defun asdf-central-registry ()
asdf:*central-registry*)
(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."
;; ugh, yeah, it's unexported - but do we really expect this to
;; change anytime soon?
(loop for name being the hash-keys of 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=))
(provide :swank-asdf)
More information about the slime-cvs
mailing list