[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