~ubuntu-branches/ubuntu/maverick/slime/maverick

« back to all changes in this revision

Viewing changes to contrib/swank-asdf.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2007-10-04 09:09:47 UTC
  • mfrom: (1.1.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20071004090947-8oy7djtx8no3erxy
Tags: 1:20070927-2
Readded tree-widget to the sources. emacs21 on
debian does _not_ have that file. emacs22 and xemacs do.
(Closes: #445174)

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
;;; swank-asdf.el -- ASDF support
 
2
;;
 
3
;; Authors: Daniel Barlow  <dan@telent.net>
 
4
;;          Marco Baringer <mb@bese.it>
 
5
;;          Edi Weitz <edi@agharta.de>
 
6
;;          and others 
 
7
;; License: Public Domain
 
8
;;
 
9
 
 
10
(in-package :swank)
 
11
 
 
12
(defslimefun operate-on-system-for-emacs (system-name operation &rest keywords)
 
13
  "Compile and load SYSTEM using ASDF.
 
14
Record compiler notes signalled as `compiler-condition's."
 
15
  (swank-compiler 
 
16
   (lambda ()
 
17
     (apply #'operate-on-system system-name operation keywords))))
 
18
 
 
19
(defun operate-on-system (system-name operation-name &rest keyword-args)
 
20
  "Perform OPERATION-NAME on SYSTEM-NAME using ASDF.
 
21
The KEYWORD-ARGS are passed on to the operation.
 
22
Example:
 
23
\(operate-on-system \"SWANK\" \"COMPILE-OP\" :force t)"
 
24
  (with-compilation-hooks ()
 
25
    (let ((operation (find-symbol operation-name :asdf)))
 
26
      (when (null operation)
 
27
        (error "Couldn't find ASDF operation ~S" operation-name))
 
28
      (apply #'asdf:operate operation system-name keyword-args))))
 
29
 
 
30
(defun asdf-central-registry ()
 
31
  asdf:*central-registry*)
 
32
 
 
33
(defslimefun list-all-systems-in-central-registry ()
 
34
  "Returns a list of all systems in ASDF's central registry."
 
35
  (mapcar #'pathname-name
 
36
          (delete-duplicates
 
37
           (loop for dir in (asdf-central-registry)
 
38
                 for defaults = (eval dir)
 
39
                 when defaults
 
40
                   nconc (mapcar #'file-namestring
 
41
                                   (directory
 
42
                                     (make-pathname :defaults defaults
 
43
                                          :version :newest
 
44
                                          :type "asd"
 
45
                                          :name :wild
 
46
                                          :case :local))))
 
47
           :test #'string=)))
 
48
 
 
49
(defslimefun list-all-systems-known-to-asdf ()
 
50
  "Returns a list of all systems ASDF knows already."
 
51
  ;; ugh, yeah, it's unexported - but do we really expect this to
 
52
  ;; change anytime soon?
 
53
  (loop for name being the hash-keys of asdf::*defined-systems*
 
54
        collect name))
 
55
 
 
56
(defslimefun list-asdf-systems ()
 
57
  "Returns the systems in ASDF's central registry and those which ASDF
 
58
already knows."
 
59
  (nunion (list-all-systems-known-to-asdf)
 
60
          (list-all-systems-in-central-registry)
 
61
          :test #'string=))
 
62
 
 
63
(provide :swank-asdf)