1 (defpackage "AUTOEXPORT"
3 (:export "LIST-AUTOEXPORTED-SYMBOLS" "LIST-AUTOEXPORTED-SYMBOLS-IN-FILE"
4 "DEFEXPORT" "EXPORT-FROM-FILE" "EXPORT-FROM-FILES" "INTERNAL"
5 "WITH-EXPORT-HANDLERS" "EXPORT-HANDLER-MAKUNBOUND"
6 "EXPORT-DEFCLASS-FORM" "EXPORT-FROM-SYSTEM"))
8 (in-package "AUTOEXPORT")
10 (declaim (special *internal*))
12 (defvar *export-handlers* (make-hash-table))
13 (defvar *noexport-prefix* #\%)
15 (defmacro defexport (operator lambda-list &body body)
17 (gethash ',operator *export-handlers*)
18 #'(lambda ,lambda-list
21 (defmacro internal (&rest symbols)
22 (declare (ignore symbols))
25 (defun export-handler-makunbound (handler)
26 (remhash handler *export-handlers*))
28 (defun list-autoexported-symbols (form)
29 (let ((handler (gethash (first form) *export-handlers*)))
31 (let ((export (apply handler (cdr form))))
34 (char= (char (string symbol) 0) *noexport-prefix*))
39 (defun export-fname (fname)
44 (defun list-autoexported-symbols-in-file (file)
45 (let ((*internal* nil))
46 (declare (special *internal*))
47 (with-open-file (in file)
48 (labels ((read-file (in)
49 (let ((form (read in nil nil)))
53 (member symbol *internal*))
56 (list-autoexported-symbols form)
60 (defmacro export-from-file (file &optional package)
62 `(export ',(list-autoexported-symbols-in-file file) ,package)
63 `(export ',(list-autoexported-symbols-in-file file))))
65 (defmacro export-from-files (files &optional package)
67 ,@(loop for file in files collect `(export-from-file ,file ,package))))
69 (defmacro export-from-system (&optional package)
70 (let ((depends-on (cdar (asdf:component-depends-on asdf:*operation* asdf:*component*))))
73 for component in depends-on
74 as pathname = (asdf:component-pathname
75 (asdf:find-component asdf:*system* component))
76 collect `(export-from-file ,pathname ,package)))))
78 (defun copy-hash-table (hash-table)
79 (let ((new-hash-table (make-hash-table
80 :test (hash-table-test hash-table)
81 :size (hash-table-size hash-table))))
84 (setf (gethash key new-hash-table) value))
88 (defmacro with-export-handlers (&body body)
89 `(let ((*export-handlers* (copy-hash-table *export-handlers*)))
93 ;;;; Exporting standard forms
95 (defexport defun (fname &rest rest)
96 (declare (ignore rest))
99 (defexport defvar (name &rest rest)
100 (declare (ignore rest))
103 (defexport defconstant (name &rest rest)
104 (declare (ignore rest))
107 (defexport defparameter (name &rest rest)
108 (declare (ignore rest))
111 (defexport defmacro (name &rest rest)
112 (declare (ignore rest))
115 (defexport deftype (name &rest rest)
116 (declare (ignore rest))
119 (defun export-defclass-form (class slotdefs &optional (export-slots-p t))
125 (if (symbolp slotdef)
128 (name &key reader writer accessor &allow-other-keys) slotdef
129 (delete nil (list (when export-slots-p name) reader (export-fname writer) accessor)))))
132 (defexport defclass (class superclasses &optional slotdefs &rest options)
133 (declare (ignore superclasses options))
134 (export-defclass-form class slotdefs))
136 (defexport define-condition (class superclasses &optional slotdefs &rest options)
137 (declare (ignore superclasses options))
138 (export-defclass-form class slotdefs))
140 (defexport defgeneric (fname &rest args)
141 (declare (ignore args))
142 (export-fname fname))
144 ;; (defexport defmethod (name &rest rest)
145 ;; (declare (ignore rest))
148 (defexport progn (&rest body)
149 (apply #'nconc (map 'list #'list-autoexported-symbols body)))
151 (defexport eval-when (case &rest body)
152 (declare (ignore case))
153 (apply #'nconc (map 'list #'list-autoexported-symbols body)))
155 (defexport internal (&rest symbols)
156 (setq *internal* (nconc *internal* symbols))