Better support for non-:upcase-readtable in slynk-completion

joaotavora · Mar 6, 2023 · e23ba11 · e23ba11
1 parent 72f5373
commit e23ba11
Showing 1 changed file with 11 additions and 11 deletions.
diff --git a/slynk/slynk-completion.lisp b/slynk/slynk-completion.lisp
@@ -255,7 +255,7 @@ A floating-point score. Higher scores for better matches."
 A match is a list (STRING SYMBOL INDEXES SCORE).
 Return non-nil if match was collected, nil otherwise."
   (multiple-value-bind (indexes score)
-      (flex-matches pattern string #'char=)
+      (flex-matches pattern (string-upcase string) #'char=)
     (when indexes
       (funcall collector
                (list string
@@ -277,8 +277,7 @@ Matches are produced by COLLECT-IF-MATCHES (which see)."
   (collecting (collect)
     (and (char= (aref pattern 0) #\:)
          (do-symbols (s +keyword-package+)
-           (collect-if-matches #'collect pattern (concatenate 'simple-string ":"
-                                                              (symbol-name s))
+           (collect-if-matches #'collect pattern (prin1-to-string s)
                                s)))))
 
 (defun accessible-matching (pattern package)
@@ -298,7 +297,10 @@ Matches are produced by COLLECT-IF-MATCHES (which see)."
                 (unless (gethash s collected)
                   (setf (gethash s collected) t)
                   (funcall #'collect thing)))
-              pattern (symbol-name s) s))))))
+              pattern (prin1-to-string s) s))))))
+
+(defun case-convert (string)
+  (princ-to-string (make-symbol string)))
 
 (defun qualified-matching (pattern home-package)
   "Find package-qualified symbols flex-matching PATTERN.
@@ -365,9 +367,9 @@ Matches are produced by COLLECT-IF-MATCHES (which see)."
                                (funcall #'collect-internal thing)))
                            pattern
                            (concatenate 'simple-string
-                                        nickname
+                                        (case-convert nickname)
                                         "::"
-                                        (symbol-name s))
+                                        (princ-to-string s))
                            s)))))
                 (t
                  (loop
@@ -390,9 +392,9 @@ Matches are produced by COLLECT-IF-MATCHES (which see)."
                                   do (collect-if-matches #'collect-external
                                                          pattern
                                                          (concatenate 'simple-string
-                                                                      nickname
+                                                                      (case-convert nickname)
                                                                       ":"
-                                                                      (symbol-name s))
+                                                                      (princ-to-string s))
                                                          s))))))))))))))
 
 (defslyfun flex-completions (pattern package-name &key (limit 300))
@@ -417,9 +419,7 @@ Returns a list of (COMPLETIONS NIL). COMPLETIONS is a list of
                     for i upto limit
                     collect e)
             collect
-            (list (if (every #'common-lisp:upper-case-p pattern)
-                      (string-upcase string)
-                      (string-downcase string))
+            (list string
                   score
                   (to-chunks string indexes)
                   (readably-classify symbol)))