X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/560af5c515eb5b6206040a9334de4254d2650147..db7a1e771d6aec41d0489b07c546d99ebbbc1019:/tools/autoexport.lisp

diff --git a/tools/autoexport.lisp b/tools/autoexport.lisp
index b4e479c..72cdeba 100644
--- 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,26 +116,35 @@ (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 progn (&rest body)
   (apply #'nconc (map 'list #'list-autoexported-symbols body)))