doc/list-exports.lisp (pretty-symbol-name): Don't hide strange symbol names.

[sod] / doc / list-exports.lisp

diff --git a/doc/list-exports.lisp b/doc/list-exports.lisp
index c47a500..bc40e95 100755 (executable)
--- a/doc/list-exports.lisp
+++ b/doc/list-exports.lisp
@@ -221,15 +221,33 @@
         (and (eq sym symbol)
              (eq how :external)))))
 
+(defun downcase-or-escape (name)
+  (if (every (lambda (char)
+              (or (upper-case-p char)
+                  (digit-char-p char)
+                  (member char '(#\% #\+ #\- #\* #\/ #\= #\[ #\] #\?))))
+            name)
+      (string-downcase name)
+      (with-output-to-string (out)
+       (write-char #\| out)
+       (map nil (lambda (char)
+                  (when (or (char= char #\|)
+                            (char= char #\\))
+                    (write-char #\\ out))
+                  (write-char char out))
+            name)
+       (write-char #\| out))))
+
 (defun pretty-symbol-name (symbol package)
   (let ((pkg (symbol-package symbol))
        (exportp (exported-symbol-p symbol)))
-    (format nil "~(~:[~A:~:[:~;~]~;~2*~]~A~)"
+    (format nil "~:[~A:~:[:~;~]~;~2*~]~A"
            (and exportp (eq pkg package))
            (cond ((keywordp symbol) "")
                  ((eq pkg nil) "#")
-                 (t (best-package-name pkg)))
-           (or exportp (null pkg)) (symbol-name symbol))))
+                 (t (downcase-or-escape (best-package-name pkg))))
+           (or exportp (null pkg))
+           (downcase-or-escape (symbol-name symbol)))))
 
 (deftype interesting-class ()
   '(or standard-class