chiark / gitweb /
doc/list-exports.lisp (pretty-symbol-name): Don't hide strange symbol names.
authorMark Wooding <mdw@distorted.org.uk>
Tue, 6 Aug 2019 11:59:29 +0000 (12:59 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Tue, 6 Aug 2019 12:06:28 +0000 (13:06 +0100)
The old code just squashed the symbol name to lowercase and printed it.
This hides symbol names which already have lowercase letters in them, or
funny characters like colons.

We don't actually have any such names.

doc/list-exports.lisp

index c47a500736d747f20ee400d6775f37e993fe13d9..bc40e958dc0d607a3ea165c2fe9f2ab770086fca 100755 (executable)
@@ -221,15 +221,33 @@ (defun exported-symbol-p (symbol &optional (package (symbol-package symbol)))
         (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