@ -42,7 +42,7 @@ Given a plist and a value, returns a key."
@@ -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
@@ -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."
@@ -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.
@@ -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."
@@ -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