X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/a535feed31204e82c6443411d16a03958c3ca4d2..437938912d93089d7716a119363e49db5a57cba8:/doc/list-exports.lisp

diff --git a/doc/list-exports.lisp b/doc/list-exports.lisp
index 9f1382b..93ee8be 100644
--- a/doc/list-exports.lisp
+++ b/doc/list-exports.lisp
@@ -123,6 +123,10 @@
     (when (or (specialized-on-p #'sod-parser:expand-parser-spec 1 symbol)
 	      (specialized-on-p #'sod-parser:expand-parser-form 1 symbol))
       (push :parser things))
+    (when (get symbol 'optparse::opthandler)
+      (push :opthandler things))
+    (when (get symbol 'optparse::optmacro)
+      (push :optmacro things))
     (nreverse things)))
 
 (defun categorize-symbols (paths package)
@@ -262,6 +266,36 @@
 					  obj))))))
 		       (sb-mop:method-specializers method))))))))))
 
+(defun check-slot-names (package)
+  (setf package (find-package package))
+  (let* ((symbols (list-exported-symbols package))
+	 (classes (mapcan (lambda (symbol)
+			    (when (eq (symbol-package symbol) package)
+			      (let ((class (find-class symbol nil)))
+				(and class (list class)))))
+			  symbols))
+	 (offenders (mapcan
+		     (lambda (class)
+		       (let* ((slot-names
+			       (mapcar #'sb-mop:slot-definition-name
+				       (sb-mop:class-direct-slots class)))
+			      (exported (remove-if-not
+					 (lambda (sym)
+					   (or (and (symbol-package sym)
+						    (not (eq (symbol-package
+							      sym)
+							     package)))
+					       (member sym symbols)))
+					 slot-names)))
+			 (and exported
+			      (list (cons (class-name class)
+					  exported)))))
+			    classes))
+	 (bad-words (remove-duplicates (mapcan (lambda (list)
+						 (copy-list (cdr list)))
+					       offenders))))
+    (values offenders bad-words)))
+
 (defun report-symbols (paths package)
   (setf package (find-package package))
   (format t "~A~%Package `~(~A~)'~2%"
@@ -276,6 +310,17 @@
 		  (pretty-symbol-name sym package)
 		  (cdr def))))
       (terpri)))
+  (multiple-value-bind (alist names) (check-slot-names package)
+    (when names
+      (format t "Leaked slot names: ~{~A~^, ~}~%"
+	      (mapcar (lambda (name) (pretty-symbol-name name package))
+		      names))
+      (dolist (assoc alist)
+	(format t "~2T~A: ~{~A~^, ~}~%"
+		(pretty-symbol-name (car assoc) package)
+		(mapcar (lambda (name) (pretty-symbol-name name package))
+			(cdr assoc))))
+      (terpri)))
   (format t "Classes:~%")
   (analyse-classes package)
   (terpri)
@@ -299,7 +344,12 @@
   (let* ((sod (asdf:find-system "sod"))
 	 (parser-files (files (by-name sod "parser")))
 	 (utilities (by-name sod "utilities"))
-	 (sod-files (remove utilities (files sod))))
+	 (sod-frontend (asdf:find-system "sod-frontend"))
+	 (optparse (by-name sod-frontend "optparse"))
+	 (frontend (by-name sod-frontend "frontend"))
+	 (sod-files (set-difference (files sod) (list utilities))))
     (report-symbols (mapcar #'file-name sod-files) "SOD")
+    (report-symbols (mapcar #'file-name (list frontend)) "SOD-FRONTEND")
     (report-symbols (mapcar #'file-name parser-files) "SOD-PARSER")
+    (report-symbols (mapcar #'file-name (list optparse)) "OPTPARSE")
     (report-symbols (mapcar #'file-name (list utilities)) "SOD-UTILITIES"))))