Added new macro EXPORT-FROM-SYSTEM

[clg] / tools / autoexport.lisp

diff --git a/tools/autoexport.lisp b/tools/autoexport.lisp
index f50479255440d6fda060d57196367b2128921ff2..72cdebae9e9a71dc931209630d3f66ca9e8758c8 100644 (file)
--- a/tools/autoexport.lisp
+++ b/tools/autoexport.lisp
@@ -1,7 +1,9 @@
 (defpackage "AUTOEXPORT"
   (:use "COMMON-LISP")
   (:export "LIST-AUTOEXPORTED-SYMBOLS" "LIST-AUTOEXPORTED-SYMBOLS-IN-FILE"
-          "DEFEXPORT" "EXPORT-FROM-FILE" "INTERNAL"))
+          "DEFEXPORT" "EXPORT-FROM-FILE" "EXPORT-FROM-FILES" "INTERNAL"
+          "WITH-EXPORT-HANDLERS" "EXPORT-HANDLER-MAKUNBOUND"
+          "EXPORT-DEFCLASS-FORM" "EXPORT-FROM-SYSTEM"))
 
 (in-package "AUTOEXPORT")
 
@@ -20,6 +22,9 @@ (defmacro internal (&rest symbols)
   (declare (ignore symbols))
   nil)
 
+(defun export-handler-makunbound (handler)
+  (remhash handler *export-handlers*))
+
 (defun list-autoexported-symbols (form)
   (let ((handler (gethash (first form) *export-handlers*)))
     (when handler
@@ -52,9 +57,38 @@ (defun list-autoexported-symbols-in-file (file)
                        (read-file in))))))))
        (read-file in)))))
   
-(defmacro export-from-file (file)
-  `(export ',(list-autoexported-symbols-in-file file)))
-
+(defmacro export-from-file (file &optional package)
+  (if package
+      `(export ',(list-autoexported-symbols-in-file file) ,package)
+    `(export ',(list-autoexported-symbols-in-file file))))
+
+(defmacro export-from-files (files &optional package)
+  `(progn 
+     ,@(loop for file in files collect `(export-from-file ,file ,package))))
+
+(defmacro export-from-system (&optional package)
+  (let ((depends-on (cdar (asdf:component-depends-on asdf:*operation* asdf:*component*))))
+    `(progn 
+       ,@(loop
+         for component in depends-on
+         as pathname = (asdf:component-pathname 
+                        (asdf:find-component asdf:*system* component))
+         collect `(export-from-file ,pathname ,package)))))
+
+(defun copy-hash-table (hash-table)
+  (let ((new-hash-table (make-hash-table 
+                        :test (hash-table-test hash-table)
+                        :size (hash-table-size hash-table))))
+    (maphash 
+     #'(lambda (key value)
+        (setf (gethash key new-hash-table) value))
+     hash-table)
+    new-hash-table))
+
+(defmacro with-export-handlers (&body body)
+  `(let ((*export-handlers* (copy-hash-table *export-handlers*)))
+     ,@body))
+               
 
 ;;;; Exporting standard forms
 
@@ -82,29 +116,34 @@ (defexport deftype (name &rest rest)
   (declare (ignore rest))
   name)
 
-(defexport defclass (class superclasses &optional slotdefs &rest options)
-  (declare (ignore superclasses options))
+(defun export-defclass-form (class slotdefs &optional (export-slots-p t))
   (cons
    class
-   (apply
-    #'nconc
-    (map
-     'list
+   (apply #'nconc
+    (map 'list
      #'(lambda (slotdef)
         (if (symbolp slotdef)
             (list slotdef)
           (destructuring-bind
               (name &key reader writer accessor &allow-other-keys) slotdef
-            (delete nil (list name reader (export-fname writer) accessor)))))
+            (delete nil (list (when export-slots-p name) reader (export-fname writer) accessor)))))
      slotdefs))))
 
+(defexport defclass (class superclasses &optional slotdefs &rest options)
+  (declare (ignore superclasses options))
+  (export-defclass-form class slotdefs))
+
+(defexport define-condition (class superclasses &optional slotdefs &rest options)
+  (declare (ignore superclasses options))
+  (export-defclass-form class slotdefs))
+
 (defexport defgeneric (fname &rest args)
   (declare (ignore args))
   (export-fname fname))
   
-(defexport defmethod (name &rest rest)
-  (declare (ignore rest))
-  name)
+;; (defexport defmethod (name &rest rest)
+;;   (declare (ignore rest))
+;;   name)
 
 (defexport progn (&rest body)
   (apply #'nconc (map 'list #'list-autoexported-symbols body)))