1 (defpackage "AUTOEXPORT"
3 (:export "LIST-AUTOEXPORTED-SYMBOLS" "LIST-AUTOEXPORTED-SYMBOLS-IN-FILE"
4 "DEFEXPORT" "EXPORT-FROM-FILE" "INTERNAL"))
6 (in-package "AUTOEXPORT")
8 (declaim (special *internal*))
10 (defvar *export-handlers* (make-hash-table))
11 (defvar *noexport-prefix* #\%)
13 (defmacro defexport (operator lambda-list &body body)
15 (gethash ',operator *export-handlers*)
16 #'(lambda ,lambda-list
19 (defmacro internal (&rest symbols)
20 (declare (ignore symbols))
23 (defun list-autoexported-symbols (form)
24 (let ((handler (gethash (first form) *export-handlers*)))
26 (let ((export (apply handler (cdr form))))
29 (char= (char (string symbol) 0) *noexport-prefix*))
34 (defun export-fname (fname)
39 (defun list-autoexported-symbols-in-file (file)
40 (let ((*internal* nil))
41 (declare (special *internal*))
42 (with-open-file (in file)
43 (labels ((read-file (in)
44 (let ((form (read in nil nil)))
48 (member symbol *internal*))
51 (list-autoexported-symbols form)
55 (defmacro export-from-file (file)
56 `(export ',(list-autoexported-symbols-in-file file)))
59 ;;;; Exporting standard forms
61 (defexport defun (fname &rest rest)
62 (declare (ignore rest))
65 (defexport defvar (name &rest rest)
66 (declare (ignore rest))
69 (defexport defconstant (name &rest rest)
70 (declare (ignore rest))
73 (defexport defparameter (name &rest rest)
74 (declare (ignore rest))
77 (defexport defmacro (name &rest rest)
78 (declare (ignore rest))
81 (defexport deftype (name &rest rest)
82 (declare (ignore rest))
85 (defun export-defclass-form (class slotdefs)
94 (name &key reader writer accessor &allow-other-keys) slotdef
95 (delete nil (list name reader (export-fname writer) accessor)))))
98 (defexport defclass (class superclasses &optional slotdefs &rest options)
99 (declare (ignore superclasses options))
100 (export-defclass-form class slotdefs))
102 (defexport define-condition (class superclasses &optional slotdefs &rest options)
103 (declare (ignore superclasses options))
104 (export-defclass-form class slotdefs))
106 (defexport defgeneric (fname &rest args)
107 (declare (ignore args))
108 (export-fname fname))
110 (defexport defmethod (name &rest rest)
111 (declare (ignore rest))
114 (defexport progn (&rest body)
115 (apply #'nconc (map 'list #'list-autoexported-symbols body)))
117 (defexport eval-when (case &rest body)
118 (declare (ignore case))
119 (apply #'nconc (map 'list #'list-autoexported-symbols body)))
121 (defexport internal (&rest symbols)
122 (setq *internal* (nconc *internal* symbols))