Update pseudonyms.lisp

pseudonyms.lisp

@@ -42,7 +42,7 @@ Given a plist and a value, returns a key."
 ;;; ========================================================================
 ;;; DEFINE/UNDEFINE FUNCTIONS
 
-(defun defpseudonym (raw-name raw-pseudonym &optional (pkgname (package-name *package*)))
+(defun defpseudonym (raw-name raw-pseudonym &key (pkgname (package-name *package*)))
   "This, given a package name and a pseudonym for it, allows you
 to use a local pseudonym in form $pseudonym:symbol instead of
 name:symbol within your code. This pseudonym is local to the package
@@ -58,7 +58,7 @@ This will signal an error whenever a nickname or pseudonym is
 already taken."
   (check-type raw-name string-designator)
   (check-type raw-pseudonym string-designator)
-  (let* ((table (gethash pkgname *pseudonym-table*))
+  (let* ((table (gethash (string-downcase pkgname) *pseudonym-table*))
 	 (name (string-downcase raw-name))
 	 (pseudonym (string-downcase raw-pseudonym))
 	 (first (car table)))
@@ -77,13 +77,13 @@ already taken."
 	    "This pseudonym is already taken by name ~S."
 	    (string=-getf-key table pseudonym))
     (if (null table)
-	(setf (gethash pkgname *pseudonym-table*)
+	(setf (gethash (string-downcase pkgname) *pseudonym-table*)
 	      (cons name (cons pseudonym nil)))
 	(setf (car table) name
 	      (cdr table) (cons pseudonym (cons first (cdr table)))))
     (format nil "~A => ~A" pseudonym name)))
 
-(defun pmakunbound (datum &optional (pkgname (package-name *package*)))
+(defun pmakunbound (datum &key (pkgname (package-name *package*)))
   "This, given either a nickname-bound package name or a
 package name-bound nickname, clears any name-nickname pair bound to it.
 
@@ -91,7 +91,7 @@ Argument must be a string designator.
 An optional argument allows you to clear a pseudonym from a different
 package."
   (check-type datum string-designator)
-  (let ((table (gethash pkgname *pseudonym-table*)))
+  (let ((table (gethash (string-downcase pkgname) *pseudonym-table*)))
     (setf datum (string-downcase datum)
 	  table
 	  (loop for (key value) on table by #'cddr
@@ -102,19 +102,20 @@ package."
 ;;; ========================================================================
 ;;; UTILITIES
 
-(defun print-pseudonyms (&optional (pkgname (package-name *package*)))
+(defun print-pseudonyms (&key (pkgname (package-name *package*)))
   "This prints all pseudonyms in a fancy manner.
 Optional argument designates the package name, from inside which 
 pseudonyms should be printed."
-  (check-type pkgname string)
-  (let ((table (gethash (package-name *package*) *pseudonym-table*)))
-    (if(null table)
-       (format t "No pseudonyms defined for package ~:@(~A~).~%" pkgname)
-       (progn
-	 (format t "pseudonym => name (package ~:@(~A~)):~%" pkgname)
-	 (list-length
-	  (loop for (key value) on table by #'cddr collecting key
-	     do (format t "~S => ~S~%" value key)))))))
+  (check-type pkgname string-designator)
+  (let* ((string (string-downcase pkgname))
+	 (table (gethash string *pseudonym-table*)))
+    (if (null table)
+	(format t "No pseudonyms defined for package ~:@(~A~).~%" pkgname)
+	(progn
+	  (format t "pseudonym => name (package ~:@(~A~)):~%" pkgname)
+	  (list-length
+	   (loop for (key value) on table by #'cddr collecting key
+	      do (format t "~S => ~S~%" value key)))))))
 
 ;;; ========================================================================
 ;;; READER MACRO