Synced with Allegro CL and SBCL syntax

README.md

@@ -39,6 +39,7 @@ Advanced-readtable has fully functional built-in support of hierarchy-packages.
 .name means "subpackage name in current package", ..name -- "subpackage name in above package",
 ...name -- "subpackage in two-level-up package" and so on.
 In in-package you may use .. for above package, ... for two level up, and so on.
+Verbose documentation one may see at [allegro CL][http://www.franz.com/support/documentation/9.0/doc/packages.htm#relative-2].
 
     CL-USER> (defpackage .test (:use cl)))
     #<PACKAGE "COMMON-LISP-USER.TEST">
@@ -55,6 +56,13 @@ In in-package you may use .. for above package, ... for two level up, and so on.
     TEST> (in-package ..)
     CL-USER>
 
+You may use local-nicknames in defpackage (syntax taken from [SBCL][https://github.com/nikodemus/SBCL/commit/3c11847d1e12db89b24a7887b18a137c45ed4661])
+
+    CL-USER> (defpackage :foo (:use :cl) (:local-nicknames (:it :cl)))
+    CL-USER> (in-package :foo)
+    FOO> (it:car '(1 2 3))
+    1
+
 
 API
 ===

finders.lisp

@@ -104,7 +104,8 @@ new handler if it is not already there.
 " 
   `(let ((key ,key) (function ,function))
      (let ((found (assoc key ,handler-list :test #'equal)))
-       (if found (cdr found)
+       (if found 
+           (setf (cdr found) function)
            (prog1
                function
              (push (cons key function)

hierarchy.lisp

@@ -24,12 +24,12 @@ Replace first section of hierarchy with proper name"
            (if pos (subseq name 0 pos) "")))
        (relative-to (parent name)
          (cond 
-           ((string= parent "") name)
+           ((string= parent "") nil)
            ((string= name "") parent)
            (t (concatenate 'string parent "." name)))))
   (defun hierarchy-find-package (name package)
     (when (string= name "")
-      (return-from hierarchy-find-package package))
+      (return-from hierarchy-find-package nil))
     (if (char= (char name 0) #\.)
       (do ((i 1 (1+ i))
            (p (package-name package) (parent p)))
@@ -46,19 +46,35 @@ Replace first section of hierarchy with proper name"
 (defmacro in-package (designator)
   `(|CL|:in-package ,(correct-package (string designator))))
 
+(defun process-local-nicknames (package pairs)
+  (let (res)
+    (dolist (pair pairs (nreverse res))
+      (destructuring-bind (sym orig) pair
+        (push (list 'push-local-nickname orig sym package) res)))))
+
 (defmacro defpackage (package &rest options)
-  (let ((normalized (normalize-package (string package)))
-        (options 
-         (mapcar (lambda (option)
-                   (cons (car option)
-                         (case (car option)
-                           (:use (mapcar #'correct-package (cdr option)))
-                           ((:import-from :shadowing-import-from)
-                            (cons (correct-package (second option))
-                                  (cddr option)))
-                           (t (cdr option)))))
-                 options)))
-    `(|CL|:defpackage ,(or normalized package) . ,options)))
+  (let (post-commands new-options
+                      (normalized (or (normalize-package (string package))
+                                      package)))
+    (dolist (option options)
+       (push (cons (car option) 
+                   (case (car option)
+                     (:use (mapcar #'correct-package (cdr option)))
+                     ((:import-from :shadowing-import-from)
+                      (cons (correct-package (second option)) (cddr option)))
+                     (:local-nicknames
+                      (progn 
+                        (mapcar 
+                         (lambda (command)
+                           (push command post-commands))
+                         (process-local-nicknames normalized (cdr option)))
+                        (go next)))
+                     (t (cdr option))))
+             new-options)
+       next)
+    `(prog1
+         (|CL|:defpackage ,normalized . ,(nreverse new-options))
+       ,@post-commands)))
 
 (defun substitute-symbol (stream symbol)
   (declare (ignore stream))