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 (defexport defclass (class superclasses &optional slotdefs &rest options)
86 (declare (ignore superclasses options))
97 (name &key reader writer accessor &allow-other-keys) slotdef
98 (delete nil (list name reader (export-fname writer) accessor)))))
101 (defexport defgeneric (fname &rest args)
102 (declare (ignore args))
103 (export-fname fname))
105 (defexport progn (&rest body)
106 (apply #'nconc (map 'list #'list-autoexported-symbols body)))
108 (defexport eval-when (case &rest body)
109 (declare (ignore case))
110 (apply #'nconc (map 'list #'list-autoexported-symbols body)))
112 (defexport internal (&rest symbols)
113 (setq *internal* (nconc *internal* symbols))