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"))
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 (defun copy-hash-table (hash-table)
70 (let ((new-hash-table (make-hash-table
71 :test (hash-table-test hash-table)
72 :size (hash-table-size hash-table))))
75 (setf (gethash key new-hash-table) value))
79 (defmacro with-export-handlers (&body body)
80 `(let ((*export-handlers* (copy-hash-table *export-handlers*)))
84 ;;;; Exporting standard forms
86 (defexport defun (fname &rest rest)
87 (declare (ignore rest))
90 (defexport defvar (name &rest rest)
91 (declare (ignore rest))
94 (defexport defconstant (name &rest rest)
95 (declare (ignore rest))
98 (defexport defparameter (name &rest rest)
99 (declare (ignore rest))
102 (defexport defmacro (name &rest rest)
103 (declare (ignore rest))
106 (defexport deftype (name &rest rest)
107 (declare (ignore rest))
110 (defun export-defclass-form (class slotdefs &optional (export-slots-p t))
116 (if (symbolp slotdef)
119 (name &key reader writer accessor &allow-other-keys) slotdef
120 (delete nil (list (when export-slots-p name) reader (export-fname writer) accessor)))))
123 (defexport defclass (class superclasses &optional slotdefs &rest options)
124 (declare (ignore superclasses options))
125 (export-defclass-form class slotdefs))
127 (defexport define-condition (class superclasses &optional slotdefs &rest options)
128 (declare (ignore superclasses options))
129 (export-defclass-form class slotdefs))
131 (defexport defgeneric (fname &rest args)
132 (declare (ignore args))
133 (export-fname fname))
135 ;; (defexport defmethod (name &rest rest)
136 ;; (declare (ignore rest))
139 (defexport progn (&rest body)
140 (apply #'nconc (map 'list #'list-autoexported-symbols body)))
142 (defexport eval-when (case &rest body)
143 (declare (ignore case))
144 (apply #'nconc (map 'list #'list-autoexported-symbols body)))
146 (defexport internal (&rest symbols)
147 (setq *internal* (nconc *internal* symbols))