Merged.

Pascal J. Bourguignon [2013-06-17 21:34]
Merged.
Filename
.gitignore
README
clext/closer-weak.lisp
clisp/fifo-stream.lisp
common-lisp/apple-file/apple-file.lisp
common-lisp/cesarum/array.lisp
common-lisp/cesarum/constraints.lisp
common-lisp/cesarum/lisp.indentations
common-lisp/cesarum/list.lisp
common-lisp/cesarum/package.lisp
common-lisp/cesarum/simple-test.lisp
common-lisp/cesarum/utility.lisp
common-lisp/lisp/generic-cl.lisp
common-lisp/lisp/ibcl.lisp
common-lisp/telnet/status.lisp
common-lisp/telnet/telnet.lisp
languages/cxx/com.informatimago.common-lisp.cxx.asd
languages/cxx/com.informatimago.languages.cxx.asd
languages/cxx/cxx.lisp
languages/linc/c-syntax.lisp
languages/linc/linc.lisp
languages/lua/com.informatimago.languages.lua.asd
languages/lua/com.informatimago.lua.asd
languages/lua/lua-parser.lisp
languages/lua/lua-scanner.lisp
languages/lua/package.lisp
rdp/com.informatimago.rdp.asd
rdp/example-lisp.lisp
rdp/packages.lisp
rdp/rdp-lisp-boilerplate.lisp
rdp/rdp.lisp
test-all-systems.lisp
tools/com.informatimago.common-lisp.tools.make-depends.asd
tools/make-depends.lisp
xcode/pbxproj.lisp
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..b25c15b
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+*~
diff --git a/README b/README
index 88dbd50..ac31285 100644
--- a/README
+++ b/README
@@ -114,6 +114,12 @@ References
         git push gitorious master


+TODO
+==================
+
+- create a library for low level utilities (eg. proper-list-p) that
+  are used by several libraries to break circular dependencies.
+

           -------------------------------------------------
                            ---------------
diff --git a/clext/closer-weak.lisp b/clext/closer-weak.lisp
index 60a8294..cca9560 100644
--- a/clext/closer-weak.lisp
+++ b/clext/closer-weak.lisp
@@ -151,7 +151,7 @@ your option) any later version.

 (defun gc ()
   "Calls the garbage collector."
-  nil
+  #-(or ccl clisp cmu sbcl) (error "~S: Missing a garbage collector call for ~S" 'gc (lisp-implementationt-type))
   #+ccl   (ccl:gc)
   #+clisp (ext:gc)
   #+cmu   (extensions:gc)
@@ -303,11 +303,10 @@ The returned list must not be destructively modified."
 ;;; Unfortunately, it looks like this is a primitive operation that
 ;;; cannot be implemented with just weak pointers.  CMUCL & SBCL are weak.

-#+(or cmu sbcl)
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (format *error-output*
-    "~2%WARNING: ~A: WEAK-OR-RELATION should be implemented ~
-     as primitive in ~A~2%" 'closer-weak (lisp-implementation-type)))
+;; #+(or cmu sbcl)
+;; (eval-when (:compile-toplevel :load-toplevel :execute)
+;;   (warn "~A: ~A is lacking a primitive WEAK-OR-RELATION."
+;;         'closer-weak (lisp-implementation-type)))

 #-(and clisp (not debug-weak))
 (defstruct (weak-or-relation (:constructor %make-weak-or-relation)
@@ -1215,6 +1214,8 @@ It has no effect when some key has already been garbage-collected.")
   (test/wl)
   (test/wht))

-(test)
+#-sbcl (test)
+;; #+sbcl (warn "~A: ~A fails weak-pointer garbage collection tests. Testing is disabled."
+;;         'closer-weak (lisp-implementation-type))

 ;;;; THE END ;;;;
diff --git a/clisp/fifo-stream.lisp b/clisp/fifo-stream.lisp
index 14c9d0c..b5e4ba1 100644
--- a/clisp/fifo-stream.lisp
+++ b/clisp/fifo-stream.lisp
@@ -92,11 +92,12 @@
 ;;; general generic functions defined on streams
 ;;;

-(defmethod close ((stream fifo-stream) &key abort)
+(defmethod close ((stream fifo-stream) &key ((:abort abort-flag) nil))
+  ;; clisp-2.49|asdf|quicklisp seem to have a constant declaration on abort.
   "
 Closes the stream and flushes any associated buffers.
 "
-  (declare (ignore abort))
+  (declare (ignore abort-flag))
   ;; When you define a primary method on this function, do not forget to
   ;; CALL-NEXT-METHOD.
   ;; TODO: (SETF (BUFFERS STREAM) 'NIL)
diff --git a/common-lisp/apple-file/apple-file.lisp b/common-lisp/apple-file/apple-file.lisp
index 0aaacc5..ec53e9e 100644
--- a/common-lisp/apple-file/apple-file.lisp
+++ b/common-lisp/apple-file/apple-file.lisp
@@ -33,7 +33,7 @@
 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
 ;;;;**************************************************************************

-0000
+
 (defpackage "COM.INFORMATIMAGO.COMMON-LISP.APPLE-FILE.APPLE-FILE"
   (:use "COMMON-LISP"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY"
@@ -254,19 +254,19 @@


 (defun check-ranges (header)
-  (let ((sorted-entries (sort (copy-list (header-entries header))
-                              (function <) :key (function entry-offset))))
-
-    )
   (let ((file-set  (make-instance 'index-set))
         (entry-set (make-instance 'index-set)))
     (dolist (entry (header-entries header))
       (assign-empty entry-set)
       (include entry-set  (make-range :start (entry-offset entry)
                                       :count (entry-length entry)))
-      (if (emptyp (intersection file-set entry-set))
+      (if (emptyp (intersection 'index-set file-set entry-set))
         (merge file-set entry-set)
-        (report-collision entry)))))
+        (report-collision header entry)))))
+
+(defun report-collision (header  entry)
+  ;; TODO:
+  (error "Some entries collide in ~S." header))


 (defun read-header (stream kind)
@@ -543,7 +543,7 @@
   (let* ((start            (resource-header-map-offset resource-header))
          (end              (+ start (resource-header-map-length resource-header)))
          (resource         (resource-header-resource resource-header))
-         (file-attributes  (get-ushort resource (+ start 22)))
+         ;; (file-attributes  (get-ushort resource (+ start 22)))
          (type-list-offset (+ start (get-short resource (+ start 24))))
          (name-list-offset (+ start (get-short resource (+ start 26))))
          (data-offset      (resource-header-data-offset resource-header)))
@@ -623,6 +623,7 @@ FORK:   (member :info :data :resource)
   (:method ((path string) format fork)
     (apple-file-fork-pathname (pathname path) format fork))
   (:method ((info-path pathname) (format (eql :apple-single)) fork)
+    (declare (ignore fork))
     info-path)
   (:method ((info-path pathname) (format (eql :apple-double)) fork)
     (let ((name (pathname-name info-path)))
@@ -644,16 +645,39 @@ FORK:   (member :info :data :resource)
                    :defaults info-path)))


+(defun tree-structure-and-leaf-difference (a b &key (test (function eql)))
+  (cond
+    ((and (null a) (null b)) '=)
+    ((or (null a) (null b)) `(/= ,a ,b))
+    ((and (atom a) (atom b))
+     (if (funcall test a b)
+         '=
+         `(/= ,a ,b)))
+    ((or (atom a) (atom b)) `(/= ,a ,b))
+    (t (cons (tree-structure-and-leaf-difference (car a) (car b) :test test)
+             (tree-structure-and-leaf-difference (cdr a) (cdr b) :test test)))))
+
 (defun test/apple-file-fork-pathname ()
-  (assert (equalp
-           (mapcar (lambda (format)
-                     (mapcar (lambda (fork)
-                               (apple-file-fork-pathname "test.single" format fork))
-                             '(:info :data :resource)))
-                   '(:apple-single :apple-double :apple-triple))
-           '((#P"test.single" #P"test.single" #P"test.single")
-             (#P"\\._test.single" #P"test.single" #P"\\._test.single")
-             (#P"test.info" #P"test.data" #P"test.rsrc"))))
+  #+unix
+  (let ((*default-pathname-defaults* #P"/"))
+    (assert
+     (tree-structure-and-leaf-difference
+      (mapcar (lambda (format)
+                (mapcar (lambda (fork)
+                          (apple-file-fork-pathname (make-pathname :name "test" :type "single" :case :local)
+                                                    format fork))
+                        '(:info :data :resource)))
+              '(:apple-single :apple-double :apple-triple))
+      (list (list (make-pathname :name "test" :type "single" :case :local)
+                  (make-pathname :name "test" :type "single" :case :local)
+                  (make-pathname :name "test" :type "single" :case :local))
+            (list (make-pathname :name "._test" :type "single" :case :local)
+                  (make-pathname :name "test" :type "single" :case :local)
+                  (make-pathname :name "._test" :type "single" :case :local))
+            (list (make-pathname :name "test" :type "info" :case :local)
+                  (make-pathname :name "test" :type "data" :case :local)
+                  (make-pathname :name "test" :type "rsrc" :case :local)))
+      :test 'pathname-match-p)))
   :success)


@@ -669,19 +693,19 @@ FORK:   (member :info :data :resource)
 (defun open-apple-file (pathname &key (direction :input) (if-does-not-exist :error))
   (assert (eq direction :input) () "non :input direction not supported yet.")
   (flet ((get-header (info-path format)
-           (let ((stream (open info-path
-                               :direction :input
-                               :if-does-not-exist nil
-                               :element-type 'octet))
-                 (header (when stream
-                           (file-position stream 0)
-                           (ignore-errors (read-header stream format)))))
+           (let* ((stream (open info-path
+                                :direction :input
+                                :if-does-not-exist nil
+                                :element-type 'octet))
+                  (header (when stream
+                            (file-position stream 0)
+                            (ignore-errors (read-header stream format)))))
              (when header
                (setf (header-info-stream header) stream))
              header)))
-    (let ((header (or (get-header (apple-file-fork-pathname pathname :apple-single :info))
-                      (get-header (apple-file-fork-pathname pathname :apple-double :info))
-                      (get-header (apple-file-fork-pathname pathname :apple-triple :info)))))
+    (let ((header (or (get-header (apple-file-fork-pathname pathname :apple-single :info) :apple-single)
+                      (get-header (apple-file-fork-pathname pathname :apple-double :info) :apple-double)
+                      (get-header (apple-file-fork-pathname pathname :apple-triple :info) :apple-triple))))
       (if header
         (make-instance 'apple-file
           :header header
@@ -694,7 +718,7 @@ FORK:   (member :info :data :resource)

 (defgeneric close-apple-file (apple-file)
   (:method ((apple-file apple-file))
-    (close (apple-file-header-info-stream apple-file))))
+    (close (header-info-stream (apple-file-header apple-file)))))

 (defun apple-file-data-fork (apple-file
                              &key (direction :input)
@@ -702,19 +726,19 @@ FORK:   (member :info :data :resource)
                                (element-type 'character)
                                (if-does-not-exist :error)
                                if-exists)
-  (let ((data-path (apple-file-fork-pathname apple-file (apple-file-header-kind apple-file) :data)))
-    ;; (if (equalp data-path (pathname (apple-file-info-stream )))
-    ;;     )
-    )
-  (open
-        :direction direction
-        :external-format external-format
-        :element-type element-type
-        :if-does-not-exist if-does-not-exist
-        :if-exists if-exists))
+  (let ((data-path (apple-file-fork-pathname apple-file (apple-file-header-kind apple-file) :data))
+        (info-path (apple-file-fork-pathname apple-file (apple-file-header-kind apple-file) :info)))
+    (if (equalp data-path info-path)
+        (error "~S not implemented for apple-triple files yet." 'apple-file-data-fork)
+        (open data-path
+              :direction direction
+              :external-format external-format
+              :element-type element-type
+              :if-does-not-exist if-does-not-exist
+              :if-exists if-exists))))

 (defun apple-file-resource-fork (apple-file)
-  (error "not implemented yet"))
+  (error "~S not implemented yet" 'apple-file-resource-fork))



@@ -763,10 +787,11 @@ FORK:   (member :info :data :resource)
 (define-attribute apple-file-prodos-auxiliary-type  :prodos-file-info    "RETURN: NIL or the PRODOS auxiliary type code of the APPLE-FILE."              file-auxiliary-type)
 (define-attribute apple-file-msdos-attributes       :msdos-file-info     "RETURN: NIL or the MSDOS attributes of the APPLE-FILE."                        file-msdos-attributes)
 (define-attribute apple-file-afp-backup-needed      :afp-file-info       "RETURN: NIL or the AFP backup needed flag of the APPLE-FILE."                  file-backup-needed)
-(define-attribute apple-file-afp-system             :afp-file-info       "RETURN: NIL or the AFP system flag of the APPLE-FILE."                         file-system)
-(define-attribute apple-file-afp-multi-user         :afp-file-info       "RETURN: NIL or the AFP multi-user flag of the APPLE-FILE."                     file-multi-user)
-(define-attribute apple-file-afp-invisible          :afp-file-info       "RETURN: NIL or the AFP invisible flag of the APPLE-FILE."                      file-invisible)
-(define-attribute apple-file-afp-directory-id       :afp-file-info       "RETURN: NIL or the AFP directory ID of the APPLE-FILE."                        file-directory-id)
+(define-attribute apple-file-afp-system             :afp-file-info       "RETURN: NIL or the AFP system flag of the APPLE-FILE."                         afp-file-system)
+(define-attribute apple-file-afp-multi-user         :afp-file-info       "RETURN: NIL or the AFP multi-user flag of the APPLE-FILE."                     afp-file-multi-user)
+(define-attribute apple-file-afp-invisible          :afp-file-info       "RETURN: NIL or the AFP invisible flag of the APPLE-FILE."                      afp-file-invisible)
+(define-attribute apple-file-afp-directory-id       :afp-file-info       "RETURN: NIL or the AFP directory ID of the APPLE-FILE."                        afp-file-directory-id)
+


 ;;----------------------------------------------------------------------
diff --git a/common-lisp/cesarum/array.lisp b/common-lisp/cesarum/array.lisp
index 9aa2f66..8e74241 100644
--- a/common-lisp/cesarum/array.lisp
+++ b/common-lisp/cesarum/array.lisp
@@ -148,7 +148,7 @@ RETURN: A displaced, adjustable array, with fill-pointer,  covering all the elem
     (make-array size
                 :element-type (array-element-type vector)
                 :displaced-to vector
-                :dispalced-index-offset (if emptyp 0 1)
+                :displaced-index-offset (if emptyp 0 1)
                 :adjustable t
                 :fill-pointer size)))

@@ -162,7 +162,7 @@ RETURN: A displaced, adjustable array, with fill-pointer, covering all the eleme
     (make-array size
                 :element-type (array-element-type vector)
                 :displaced-to vector
-                :dispalced-index-offset 0
+                :displaced-index-offset 0
                 :adjustable t
                 :fill-pointer size)))

diff --git a/common-lisp/cesarum/constraints.lisp b/common-lisp/cesarum/constraints.lisp
index 06f2ec0..2dc1208 100644
--- a/common-lisp/cesarum/constraints.lisp
+++ b/common-lisp/cesarum/constraints.lisp
@@ -394,39 +394,6 @@ NOTE:    This version avoids calling FUN twice with the same argument.
      :finally (return set)))


-(defun topological-sort (nodes lessp)
-  "
-RETURN: A list of NODES sorted topologically according to
-        the partial order function LESSP.
-        If there are cycles (discounting reflexivity),
-        then the list returned won't contain all the NODES.
-"
-  (loop
-     :with sorted = '()
-     :with incoming = (map 'vector (lambda (to)
-                                     (loop
-                                        :for from :in nodes
-                                        :when (and (not (eq from to))
-                                                   (funcall lessp from to))
-                                        :sum 1))
-                           nodes)
-     :with q = (loop
-                  :for node :in nodes
-                  :for inco :across incoming
-                  :when (zerop inco)
-                  :collect node)
-     :while q
-     :do (let ((n (pop q)))
-           (push n sorted)
-           (loop
-              :for m :in nodes
-              :for i :from 0
-              :do (when (and (and (not (eq n m))
-                                  (funcall lessp n m))
-                             (zerop (decf (aref incoming i))))
-                    (push m q))))
-     :finally (return (nreverse sorted))))
-

 (defun solve-constraints (edges propagate)
   "
diff --git a/common-lisp/cesarum/lisp.indentations b/common-lisp/cesarum/lisp.indentations
new file mode 100644
index 0000000..90da9ff
--- /dev/null
+++ b/common-lisp/cesarum/lisp.indentations
@@ -0,0 +1,5 @@
+;; -*- mode:lisp -*-
+
+(1 collecting-result
+   defenum)
+
diff --git a/common-lisp/cesarum/list.lisp b/common-lisp/cesarum/list.lisp
index c780e92..6f5a2ad 100644
--- a/common-lisp/cesarum/list.lisp
+++ b/common-lisp/cesarum/list.lisp
@@ -775,6 +775,18 @@ EXAMPLE: (tree-difference '((a b c) 1 (d e f)) '((a b c) (1) (d x f)))
              (tree-difference (cdr a) (cdr b) :test test)))))


+(defun tree-structure-and-leaf-difference (a b &key (test (function eql)))
+  (cond
+    ((and (null a) (null b)) '=)
+    ((or (null a) (null b)) `(/= ,a ,b))
+    ((and (atom a) (atom b))
+     (if (funcall test a b)
+         '=
+         `(/= ,a ,b)))
+    ((or (atom a) (atom b)) `(/= ,a ,b))`(/= ,a ,b)
+    (t (cons (tree-structure-and-leaf-difference (car a) (car b) :test test)
+             (tree-structure-and-leaf-difference (cdr a) (cdr b) :test test)))))
+
 (defun replace-tree (dst src)
   "
 DO:     Copies the elements of the src tree into the dst tree.
diff --git a/common-lisp/cesarum/package.lisp b/common-lisp/cesarum/package.lisp
index 0cb0d0d..a6f0fe1 100644
--- a/common-lisp/cesarum/package.lisp
+++ b/common-lisp/cesarum/package.lisp
@@ -265,9 +265,6 @@ SEE ALSO:  REGISTER, LOAD-PACKAGE, ADD-NICKNAME.
 (defmacro verbose (fctrl &rest args)
   `(when *package-verbose* (format *vout* ,fctrl ,@args)))

-(defmacro while (condition &body body)  `(do () ((not ,condition))  ,@body))
-
-
 (defun package-exports (package)
   "
 RETURN:   A new list of exported symbols from PACKAGE.
@@ -736,8 +733,5 @@ DO:         Declares a package.
        (defpackage ,name ,@defpack-args)
        (in-package ,name))))

-
-
-
-;;;; package.lisp                     --                     --          ;;;;
+;;;; THE END ;;;;

diff --git a/common-lisp/cesarum/simple-test.lisp b/common-lisp/cesarum/simple-test.lisp
index ced2f22..35db03e 100644
--- a/common-lisp/cesarum/simple-test.lisp
+++ b/common-lisp/cesarum/simple-test.lisp
@@ -33,7 +33,8 @@
 ;;;;**************************************************************************

 (defpackage "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SIMPLE-TEST"
-  (:use "COMMON-LISP")
+  (:use "COMMON-LISP"
+        "COM.INFORMATIMAGO.COMMON-LISP.LISP-SEXP.SOURCE-FORM")
   (:export "*DEBUG-ON-ERROR*" "WITH-DEBUGGER-ON-ERROR"
            "DEFINE-TEST" "TEST" "ASSERT-TRUE" "EXPECT-CONDITION"

@@ -279,22 +280,25 @@ EXAMPLE:  (test equal (list 1 2 3) '(1 2 3))
                      :for param :in parameters
                      :while (symbolp param)
                      :collect param)))
-    `(defun ,name ,parameters
-       (multiple-value-bind (successes failures)
-           (let ((*success-count* 0)
-                 (*failure-count* 0)
-                 (*current-test-name*        ',name)
-                 (*current-test-parameters* (list ,@mandatory))
-                 (*current-test-printed-p*  nil))
-             (progress-start)
-             (locally ,@body)
-             (progress-tally *success-count* *failure-count*)
-             (values *success-count* *failure-count*))
-         (incf *success-count* successes)
-         (incf *failure-count* failures)
-         (if (zerop failures)
-             :success
-             :failure)))))
+    (multiple-value-bind (docstrings declarations forms) (parse-body :lambda body)
+      `(defun ,name ,parameters
+         ,@docstrings
+         ,@declarations
+         (multiple-value-bind (successes failures)
+             (let ((*success-count* 0)
+                   (*failure-count* 0)
+                   (*current-test-name*        ',name)
+                   (*current-test-parameters* (list ,@mandatory))
+                   (*current-test-printed-p*  nil))
+               (progress-start)
+               (progn ,@forms)
+               (progress-tally *success-count* *failure-count*)
+               (values *success-count* *failure-count*))
+           (incf *success-count* successes)
+           (incf *failure-count* failures)
+           (if (zerop failures)
+               :success
+               :failure))))))

 (defmacro with-debugger-on-error (&body body)
   `(let ((*debug-on-error* t))
diff --git a/common-lisp/cesarum/utility.lisp b/common-lisp/cesarum/utility.lisp
index cba4ac7..5416a87 100644
--- a/common-lisp/cesarum/utility.lisp
+++ b/common-lisp/cesarum/utility.lisp
@@ -769,16 +769,14 @@ DO:       Execute the BODY with a handler for CONDITION and
 "
   `(handler-case (progn ,@body)
      (simple-condition  (err)
-       (format *error-output* "~&~A: ~%" (class-name (class-of err)))
-       (apply (function format) *error-output*
-              (simple-condition-format-control   err)
-              (simple-condition-format-arguments err))
-       (format *error-output* "~&")
-       (finish-output))
+       (format *error-output* "~&~A:~%~?~&"
+               (class-name (class-of err))
+               (simple-condition-format-control   err)
+               (simple-condition-format-arguments err))
+       (finish-output *error-output*))
      (condition (err)
-       (format *error-output* "~&~A: ~%  ~A~%" (class-name (class-of err)) err)
-       (finish-output))))
-
+       (format *error-output* "~&~A:~%~A~%" (class-name (class-of err)) err)
+       (finish-output *error-output*))))


 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -940,41 +938,44 @@ NOTE:    This version avoids calling FUN twice with the same argument.
 ;; (array->list array) --> (coerce array 'list)
 ;; (DEFUN ARRAY->LIST (A) (MAP 'LIST (FUNCTION IDENTITY) A));;ARRAY->LIST

-
 (defun topological-sort (nodes lessp)
-  "
+   "
 RETURN: A list of NODES sorted topologically according to
         the partial order function LESSP.
         If there are cycles (discounting reflexivity),
         then the list returned won't contain all the NODES.
 "
-  (loop
+   (loop
      :with sorted = '()
      :with incoming = (map 'vector (lambda (to)
                                      (loop
-                                        :for from :in nodes
-                                        :when (and (not (eq from to))
-                                                   (funcall lessp from to))
-                                        :sum 1))
+                                       :for from :in nodes
+                                       :when (and (not (eq from to))
+                                                  (funcall lessp from to))
+                                       :sum 1))
                            nodes)
      :with q = (loop
-                  :for node :in nodes
-                  :for inco :across incoming
-                  :when (zerop inco)
-                  :collect node)
+                 :for node :in nodes
+                 :for inco :across incoming
+                 :when (zerop inco)
+                 :collect node)
      :while q
      :do (let ((n (pop q)))
            (push n sorted)
            (loop
-              :for m :in nodes
-              :for i :from 0
-              :do (when (and (and (not (eq n m))
-                                  (funcall lessp n m))
-                             (zerop (decf (aref incoming i))))
-                    (push m q))))
+             :for m :in nodes
+             :for i :from 0
+             :do (when (and (and (not (eq n m))
+                                 (funcall lessp n m))
+                            (zerop (decf (aref incoming i))))
+                   (push m q))))
      :finally (return (nreverse sorted))))


+
+
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 15 - ARRAYS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/common-lisp/lisp/generic-cl.lisp b/common-lisp/lisp/generic-cl.lisp
index cfa4e77..4ec092b 100644
--- a/common-lisp/lisp/generic-cl.lisp
+++ b/common-lisp/lisp/generic-cl.lisp
@@ -33,7 +33,7 @@
 ;;;;**************************************************************************

 (in-package "COMMON-LISP-USER")
-(defpackage "COM.INFORMATIMAGO.COMMON-LISP.GENERIC-COMMON-LISP"
+(defpackage "COM.INFORMATIMAGO.COMMON-LISP.LISP.GENERIC-COMMON-LISP"
   (:nicknames "GENERIC-COMMON-LISP"
               "GENERIC-CL")
   (:use "COMMON-LISP")
@@ -48,13 +48,25 @@ This package is provided under the Afero General Public License 3.
 See the source file for details.

 "))
-(in-package "COM.INFORMATIMAGO.COMMON-LISP.GENERIC-COMMON-LISP")
+(in-package "COM.INFORMATIMAGO.COMMON-LISP.LISP.GENERIC-COMMON-LISP")




 ;; export at the end.

+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defparameter *not-implemented-yet* (make-hash-table :test (function equal))))
+
+(defmacro not-implemented-yet (what)
+  (unless (gethash what *not-implemented-yet*)
+    (setf (gethash what *not-implemented-yet*) t)
+    (warn "~S not implemented yet." what))
+  `(progn
+     (unless (gethash ',what *not-implemented-yet*)
+       (setf (gethash ',what *not-implemented-yet*) t)
+       (warn "~S not implemented yet." ',what))
+     nil))

 (defmacro define-forward (name arguments)
   ;; (let* ((lambda-list       (parse-lambda-list arguments :ordinary))
@@ -78,7 +90,16 @@ See the source file for details.
   ;;          ,(if (consp name)
   ;;               `(setf (,cl-name ,@(cdr arguments)) ,(car arguments))
   ;;               `(,cl-name ,@arguments))))))
-  `(error "Not implemented yet."))
+  (declare (ignore name arguments))
+  (not-implemented-yet define-forward))
+
+(defmacro defmethod-and-forward (name fname arguments)
+  (declare (ignore name fname arguments))
+  (not-implemented-yet defmethod-and-forward))
+
+(defmacro define-method (name qualifiers-or-lambda-list &body body)
+  (declare (ignore name qualifiers-or-lambda-list body))
+  (not-implemented-yet define-method))

 ;; t
 ;;    sequence
@@ -90,9 +111,6 @@ See the source file for details.
 ;;       direct-access-sequence
 ;;       sequential-access-sequence

-(defclass user-sequence ()
-  ()
-  (:documentation "Abstract class for user defined sequeneces."))


 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -197,19 +215,17 @@ See the source file for details.
                          (test (function eql)) test-not))))

 (define-forward replace
-    (sequence-1 sequence-2 &key (start1 0) (end1 nil)(start2 0) (end2 nil)))
+    (sequence-1 sequence-2 &key (start1 0) (end1 nil) (start2 0) (end2 nil)))

 (defmethod-and-forward substitute    nsubstitute
   (newitem olditem (self  sequential-access-sequence)
            &key (from-end nil) (test (function eql)) test-not
-           (start 0) (end nil) (count nil) (key nil))
-  )
+           (start 0) (end nil) (count nil) (key nil)))

 (defmethod-and-forward substitute-if nsubstitute-if
   (newitem olditem (self  sequential-access-sequence)
            &key (from-end nil) (test (function eql)) test-not
-           (start 0) (end nil) (count nil) (key nil))
-  )
+           (start 0) (end nil) (count nil) (key nil)))

 (defmethod-and-forward substitute-if-not nsubstitute-if-not
   (newitem olditem (self  sequential-access-sequence)
@@ -233,7 +249,7 @@ See the source file for details.


 ;; We must pass the symbol in a list to export CL:NIL.
-(export (mapcar (lambda (name) (intern name "IBCL"))
+(export (mapcar (lambda (name) (intern name "GENERIC-CL"))
                 (let ((symbols '()))
                   (do-external-symbols (sym "COMMON-LISP")
                     (push (string sym) symbols))
@@ -242,34 +258,52 @@ See the source file for details.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


-(defmethod closer-mop:validate-superclass :before ((c class) (s class))
-  (call-next-method))
-
-(defmethod closer-mop:validate-superclass :before
-    ((class class) (superclass class))
-  (or (and (eql (find-class 'user-sequence)) (eql #.(find-class 'sequence)))
-      (call-next-method)))
-
-
 ;;;---------------------------------------------------------------------
 ;;; So now, we can define our own subclasses of sequences.
 ;;;---------------------------------------------------------------------

-(defclass user-sequence (sequence)
+
+;; (define-method closer-mop:validate-superclass :before ((c class) (s class))
+;;   (call-next-method))
+
+
+;; (remove-method (function closer-mop:validate-superclass)
+;;                (find-method (function closer-mop:validate-superclass)
+;;                             ':before
+;;                             '(class  class)))
+
+;;; this doesn't work on ccl for built-in-class vs stanard-class
+;;; and not on clisp for find-class can't find the class pased in arguments.
+;; (define-method closer-mop:validate-superclass :before
+;;     ((class class) (superclass class))
+;;   (warn "~S check again this implementation!"'(closer-mop:validate-superclass :before
+;;                                                ((class class) (superclass class))))
+;;   (print class)
+;;   (print (list class  (eql class       (find-class 'user-sequence))
+;;                superclass (eql superclass  (load-time-value (find-class 'sequence)))))
+;;   (print (or (and #-clisp (eql class       (find-class 'user-sequence))
+;;                   #+clisp (eq 'user-sequence (class-name class))
+;;                   (eql superclass  (load-time-value (find-class 'sequence))))
+;;              (call-next-method))))
+
+(warn "TODO: implement user-sequence as subclass of sequence")
+(defclass user-sequence (#+not-yet sequence)
   ()
   (:documentation "Our own abstract sequence class."))


+
+
 ;;;---------------------------------------------------------------------
 ;;; Abstract direct access sequence
 ;;;---------------------------------------------------------------------


 (defclass direct-access-sequence (user-sequence)
-  ((length :reader length))
+  ((length #+not-yet :reader #+not-yet length))
   (:documentation "A class of vector-like sequences with direct access."))

-(defmethod copy-seq ((self direct-access-sequence))
+(define-method copy-seq ((self direct-access-sequence))
   (let ((copy (make-instance (class-of self) :size (length self))))
     (loop
        :for i :from 0 :below (length self)
@@ -277,8 +311,8 @@ See the source file for details.
        :finally (return copy))))

 ;;; primitives:
-;;; (defmethod elt ((self direct-access-sequence) index) )
-;;; (defmethod (setf elt) (value (self direct-access-sequence) index)   value)
+;;; (define-method elt ((self direct-access-sequence) index) )
+;;; (define-method (setf elt) (value (self direct-access-sequence) index)   value)


 ;;;---------------------------------------------------------------------
@@ -317,14 +351,14 @@ RETURN: the value at the cursor position in the sequence."))
 POST:   (not (sas-cursor-end-p self))"))


-(defmethod length ((self sequential-access-sequence))
+(define-method length ((self sequential-access-sequence))
   (loop
      :for cursor = (sas-head self) :then (sas-cursor-next cursor)
      :for length :from 0
      :until (sas-cursor-end-p cursor)
      :finally (return length)))

-(defmethod copy-seq ((self sequential-access-sequence))
+(define-method copy-seq ((self sequential-access-sequence))
   (let ((copy  (make-instance (class-of self))))
     (loop
        :for src = (sas-head self) :then (sas-cursor-next src)
@@ -333,7 +367,7 @@ POST:   (not (sas-cursor-end-p self))"))
        :do (setf (sas-cursor-value dst) (sas-cursor-value src))
        :finally (return copy))))

-(defmethod elt ((self sequential-access-sequence) index)
+(define-method elt ((self sequential-access-sequence) index)
   (check-type index (integer 0))
   (loop
      :for cursor = (sas-head self) :then (sas-cursor-next cursor)
@@ -342,7 +376,7 @@ POST:   (not (sas-cursor-end-p self))"))
              (check-type index `(integer 0 ,length))
              (return (sas-cursor-value cursor)))))

-(defmethod (setf elt) (value (self sequential-access-sequence) index)
+(define-method (setf elt) (value (self sequential-access-sequence) index)
   (check-type index (integer 0))
   (loop
      :for cursor = (sas-head self) :then (sas-cursor-next cursor)
@@ -352,29 +386,31 @@ POST:   (not (sas-cursor-end-p self))"))
              (return (setf  (sas-cursor-value cursor) value)))))


-(defmethod fill ((self sequential-access-sequence) item &key (start 0) (end nil))
+(define-method fill ((self sequential-access-sequence) item &key (start 0) (end nil))
   (loop
      :for cursor = (sas-head self) :then (sas-cursor-next cursor)
-     :for index :from 0 :below index
+     :for index :from start :below end
      :do (cond
            ((sas-cursor-end-p cursor) (return self))
            ((< index start))
            ((and end (<= end index))  (return self))
            (t                         (setf  (sas-cursor-value cursor) item)))))

-(defmethod subseq ((self sequential-access-sequence) start &optional (end nil))
+(define-method subseq ((self sequential-access-sequence) start &optional (end nil))
   (loop
      :with sub = (make-instance (class-of self))
      :with dst = (sas-head sub)
-     :for  src = (sas-head self) :then (sas-cursor-next cursor)
-     :for  index :from 0 :below index
+     :for  src = (sas-head self) :then (sas-cursor-next src)
+     :for  index :from start
      :do (cond
            ((sas-cursor-end-p src)    (return sub))
            ((< index start))
            ((and end (<= end index))  (return sub))
            (t  (setf (sas-cursor-value dst) (sas-cursor-value src))))))

-(defmethod (setf subseq) (value sequence start &optional (end nil)))
+(define-method (setf subseq) (value sequence start &optional (end nil))
+  (declare (ignore value sequence start end))
+  (not-implemented-yet  (setf subseq)))
 (define-forward map           (result-type function sequence &rest sequences))
 (define-forward map-into      (result-sequence function &rest sequences))
 (define-forward length        (sequence))
@@ -386,7 +422,9 @@ POST:   (not (sas-cursor-end-p self))"))
                                            &key (key nil)))


-(defmethod make-sequence ((result-type sequence) size &key initial-element))
+(define-method make-sequence ((result-type sequence) size &key initial-element)
+  (declare (ignore result-type size initial-element))
+  (not-implemented-yet  make-sequence))


 (dolist (name '(remove delete))
@@ -456,143 +494,5 @@ POST:   (not (sas-cursor-end-p self))"))



-
-
-;;;---------------------------------------------------------------------
-;;; So now, we can define our own subclasses of sequences.
-;;;---------------------------------------------------------------------
-
-(defclass sequence ()
-  ()
-  (:documentation "Our own abstract sequence class."))
-
-
-;;;---------------------------------------------------------------------
-;;; Abstract direct access sequence
-;;;---------------------------------------------------------------------
-
-(defclass direct-access-sequence (sequence)
-  ((length :reader length))
-  (:documentation "A class of vector-like sequences with direct access."))
-
-(defmethod copy-seq ((self direct-access-sequence))
-  (let ((copy (make-instance (class-of self) :size (length self))))
-    (loop
-       :for i :from 0 :below (length self)
-       :do (setf (elt copy i)  (elt self i))
-       :finally (return copy))))
-
-;;; primitives:
-;;; (defmethod elt ((self direct-access-sequence) index) )
-;;; (defmethod (setf elt) (value (self direct-access-sequence) index)   value)
-
-
-;;;---------------------------------------------------------------------
-;;; Abstract sequential access sequence
-;;;---------------------------------------------------------------------
-
-(defclass sequential-access-sequence (sequence)
-  ()
-  (:documentation "A class of list-like sequences with sequential access."))
-
-(defgeneric sas-head (self)
-  (:documentation "RETURN:  A cursor at the head of the sequence."))
-
-
-(defclass sas-cursor ()
-  ((sas :reader cursor-sas :initarg :sequence))
-  (:documentation "A cursor on a sequential access sequence."))
-(defgeneric sas-cursor-copy (self)
-  (:documentation
-   "RETURN: a copy of the cursor.
-        Calling (sas-cursor-next self) won't change the copy."))
-(defgeneric sas-cursor-next (self)
-  (:documentation "RETURN:  the next cursor.
-         May modify self, or may return a new object."))
-(defgeneric sas-cursor-end-p  (self)
-  (:documentation
-   "RETURN:  whether the cursor has reached the end of the sequence."))
-(defgeneric sas-cursor-value (self)
-  (:documentation
-   "PRE: (not (sas-cursor-end-p self))
-RETURN: the value at the cursor position in the sequence."))
-(defgeneric (setf sas-cursor-value) (value self)
-  (:documentation
-   "DO:     Sets the value at the cursor position in the sequence.
-        If the cursor is at the end, then append then new value.
-POST:   (not (sas-cursor-end-p self))"))
-
-
-(defmethod length ((self sequential-access-sequence))
-  (loop
-     :for cursor = (sas-head self) :then (sas-cursor-next cursor)
-     :for length :from 0
-     :until (sas-cursor-end-p cursor)
-     :finally (return length)))
-
-(defmethod copy-seq ((self sequential-access-sequence))
-  (let ((copy  (make-instance (class-of self))))
-    (loop
-       :for src = (sas-head self) :then (sas-cursor-next src)
-       :for dst = (sas-head self) :then (sas-cursor-next dst)
-       :until (sas-cursor-end-p src)
-       :do (setf (sas-cursor-value dst) (sas-cursor-value src))
-       :finally (return copy))))
-
-(defmethod elt ((self sequential-access-sequence) index)
-  (check-type index (integer 0))
-  (loop
-     :for cursor = (sas-head self) :then (sas-cursor-next cursor)
-     :for length :from 0 :below index
-     :do (if (sas-cursor-end-p cursor)
-             (check-type index `(integer 0 ,length))
-             (return (sas-cursor-value cursor)))))
-
-(defmethod (setf elt) (value (self sequential-access-sequence) index)
-  (check-type index (integer 0))
-  (loop
-     :for cursor = (sas-head self) :then (sas-cursor-next cursor)
-     :for length :from 0 :below index
-     :do (if (sas-cursor-end-p cursor)
-             (check-type index `(integer 0 ,length))
-             (return (setf  (sas-cursor-value cursor) value)))))
-
-
-(defmethod fill ((self sequential-access-sequence) item &key (start 0) (end nil))
-  (loop
-     :for cursor = (sas-head self) :then (sas-cursor-next cursor)
-     :for index :from 0 :below index
-     :do (cond
-           ((sas-cursor-end-p cursor) (return self))
-           ((< index start))
-           ((and end (<= end index))  (return self))
-           (t                         (setf  (sas-cursor-value cursor) item)))))
-
-(defmethod subseq ((self sequential-access-sequence) start &optional (end nil))
-  (loop
-     :with sub = (make-instance (class-of self))
-     :with dst = (sas-head sub)
-     :for  src = (sas-head self) :then (sas-cursor-next cursor)
-     :for  index :from 0 :below index
-     :do (cond
-           ((sas-cursor-end-p src)    (return sub))
-           ((< index start))
-           ((and end (<= end index))  (return sub))
-           (t  (setf (sas-cursor-value dst) (sas-cursor-value src))))))
-
-(defmethod (setf subseq) (value sequence start &optional (end nil)))
-(define-forward map           (result-type function sequence &rest sequences))
-(define-forward map-into      (result-sequence function &rest sequences))
-(define-forward length        (sequence))
-(define-forward nreverse      (sequence))
-(define-forward sort          (sequence predicate &key (key nil)))
-(define-forward stable-sort   (sequence predicate &key (key nil)))
-(define-forward concatenate   (result-type &rest sequences))
-(define-forward merge         (result-type sequence-1 sequence-2 predicate
-                                           &key (key nil)))
-
-
-(defmethod make-sequence ((result-type sequence) size &key initial-element))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; THE END ;;;;
diff --git a/common-lisp/lisp/ibcl.lisp b/common-lisp/lisp/ibcl.lisp
index ba2bafc..e3b14dc 100644
--- a/common-lisp/lisp/ibcl.lisp
+++ b/common-lisp/lisp/ibcl.lisp
@@ -205,7 +205,7 @@ See the source file for details.
 (defun make-package (package &key nicknames uses)
   (cl:make-package package
                    :nicknames nicknames
-                   :uses (substitute-packages *package-map* uses)))
+                   :use (substitute-packages *package-map* uses)))

 (defmacro with-package-iterator ((name package-list-form &rest symbol-types) &body body)
   `(cl:with-package-iterator (,name
diff --git a/common-lisp/telnet/status.lisp b/common-lisp/telnet/status.lisp
index c25fdf0..1d1e796 100644
--- a/common-lisp/telnet/status.lisp
+++ b/common-lisp/telnet/status.lisp
@@ -74,7 +74,7 @@ or:
 (defmethod send-status-request ((opt status) nvt)
   "Send a STATUS SEND message."
   (if (option-enabled-p nvt :status :him)
-      (send-raw-bytes nvt (vector IAC SB STATUS SEND IAC SE))
+      (send-raw-bytes nvt (vector IAC SB STATUS tq-SEND IAC SE))
       (error 'telnet-option-error
              :nvt nvt
              :option opt
@@ -141,9 +141,10 @@ We send a RECEIVE-OPTION message to the UP-SENDER with a value such as:
                                                          (#.IAC (if (= IAC (aref bytes (1+ j)))
                                                                     (incf j 2)
                                                                     (return j)))
-                                                         (otherwise (incf j))))))
-                                        (prog1 (decode-subnegotiation opt bytes :start i :end j)
-                                          (setf i j))))
+                                                         (otherwise (incf j)))
+                                                   :finally (return j))))
+                                        (prog1 (decode-subnegotiation opt bytes :start i :end end)
+                                          (setf i end))))
                                      (otherwise
                                       (warn 'telnet-option-warning
                                             :nvt nvt
@@ -159,8 +160,8 @@ We send a RECEIVE-OPTION message to the UP-SENDER with a value such as:
 (defmethod receive-subnegotiation ((opt status) nvt bytes &key (start 0) (end (length bytes)))
   "Parses the STATUS subnegotiation.
 The NVT has already parsed 'IAC SB STATUS' and 'IAC SE'.
-IAC SB STATUS SEND IAC SE
-IAC SB STATUS IS … IAC SE
+IAC SB STATUS TQ-SEND IAC SE
+IAC SB STATUS TQ-IS … IAC SE
 "
   (let ((len    (- end start))
         (subcmd (aref bytes (+ start 3))))
diff --git a/common-lisp/telnet/telnet.lisp b/common-lisp/telnet/telnet.lisp
index e2a36e7..7ecf465 100644
--- a/common-lisp/telnet/telnet.lisp
+++ b/common-lisp/telnet/telnet.lisp
@@ -834,8 +834,9 @@ accompanied by a TCP Urgent notification.")
   ((code :initarg :code
          :reader option-code)
    (name :initarg :name)
-   (us   :initform :no    :type side-option-state
-         :accessor opt-us)
+   (#-sbcl us #+sbcl sbcl-has-a-bug-so-we-cannot-name-our-slot-us-see-|https://bugs.launchpad.net/sbcl/+bug/539540|
+           :initform :no    :type side-option-state
+           :accessor opt-us)
    (usq  :initform :empty :type side-option-queue
          :accessor opt-usq)
    (him  :initform :no    :type side-option-state
@@ -1731,7 +1732,7 @@ The returned sexp must start with (:SB option-name …).
     (declare (ignore byte start end))
     (cerror "Ignore the subnegotiation status."
             'telnet-option-error
-            :nvt nvt
+            ;; :nvt nvt ;; TODO: Do we need it? Should we keep the nvt in a dynamic variable?
             :option opt
             :format-control "Option STATUS received an unknown subnegotiation status for option ~:@(~A~)."
             :format-arguments (list (option-name opt)))
diff --git a/languages/cxx/com.informatimago.common-lisp.cxx.asd b/languages/cxx/com.informatimago.common-lisp.cxx.asd
deleted file mode 100644
index cd99cae..0000000
--- a/languages/cxx/com.informatimago.common-lisp.cxx.asd
+++ /dev/null
@@ -1,68 +0,0 @@
-;;;; -*- mode:lisp;coding:utf-8 -*-
-;;;;**************************************************************************
-;;;;FILE:               com.informatimago.common-lisp.cxx.asd
-;;;;LANGUAGE:           Common-Lisp
-;;;;SYSTEM:             Common-Lisp
-;;;;USER-INTERFACE:     NONE
-;;;;DESCRIPTION
-;;;;
-;;;;    ASD file to load the com.informatimago.common-lisp.cxx library.
-;;;;
-;;;;AUTHORS
-;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
-;;;;MODIFICATIONS
-;;;;    2010-10-31 <PJB> Created this .asd file.
-;;;;BUGS
-;;;;LEGAL
-;;;;    AGPL3
-;;;;
-;;;;    Copyright Pascal J. Bourguignon 2010 - 2012
-;;;;
-;;;;    This program is free software: you can redistribute it and/or modify
-;;;;    it under the terms of the GNU Affero General Public License as published by
-;;;;    the Free Software Foundation, either version 3 of the License, or
-;;;;    (at your option) any later version.
-;;;;
-;;;;    This program is distributed in the hope that it will be useful,
-;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;;    GNU Affero General Public License for more details.
-;;;;
-;;;;    You should have received a copy of the GNU Affero General Public License
-;;;;    along with this program.  If not, see http://www.gnu.org/licenses/
-;;;;**************************************************************************
-
-(asdf:defsystem :com.informatimago.common-lisp.cxx
-
-    ;; system attributes:
-
-    :description "Restricted C++ parser, used just to analyze the call graph of C++ functions and methods."
-
-    :author     "Pascal J. Bourguignon <pjb@informatimago.com>"
-
-    :maintainer "Pascal J. Bourguignon <pjb@informatimago.com>"
-
-    :licence "AGPL3"
-
-
-    ;; component  attributes:
-
-    :name "Informatimago partial C++ Parser"
-
-    :version "1.2.1"
-
-    :properties ((#:author-email                   . "pjb@informatimago.com")
-                 (#:date                           . "Autumn 2010")
-                 ((#:albert #:output-dir)          . "/tmp/documentation/com.informatimago.common-lisp.cxx/")
-                 ((#:albert #:formats)             . ("docbook"))
-                 ((#:albert #:docbook #:template)  . "book")
-                 ((#:albert #:docbook #:bgcolor)   . "white")
-                 ((#:albert #:docbook #:textcolor) . "black"))
-
-    #+asdf-unicode :encoding #+asdf-unicode :utf-8
-
-    :depends-on ("com.informatimago.common-lisp.cesarum")
-
-    :components ((:file "cxx" :depends-on ())))
-
-;;;; THE END ;;;;
diff --git a/languages/cxx/com.informatimago.languages.cxx.asd b/languages/cxx/com.informatimago.languages.cxx.asd
new file mode 100644
index 0000000..519c2fc
--- /dev/null
+++ b/languages/cxx/com.informatimago.languages.cxx.asd
@@ -0,0 +1,68 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               com.informatimago.languages.cxx.asd
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    ASD file to load the com.informatimago.languages.cxx library.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2010-10-31 <PJB> Created this .asd file.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2010 - 2012
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see http://www.gnu.org/licenses/
+;;;;**************************************************************************
+
+(asdf:defsystem :com.informatimago.languages.cxx
+
+    ;; system attributes:
+
+    :description "Restricted C++ parser, used just to analyze the call graph of C++ functions and methods."
+
+    :author     "Pascal J. Bourguignon <pjb@informatimago.com>"
+
+    :maintainer "Pascal J. Bourguignon <pjb@informatimago.com>"
+
+    :licence "AGPL3"
+
+
+    ;; component  attributes:
+
+    :name "Informatimago partial C++ Parser"
+
+    :version "1.2.1"
+
+    :properties ((#:author-email                   . "pjb@informatimago.com")
+                 (#:date                           . "Autumn 2010")
+                 ((#:albert #:output-dir)          . "/tmp/documentation/com.informatimago.languages.cxx/")
+                 ((#:albert #:formats)             . ("docbook"))
+                 ((#:albert #:docbook #:template)  . "book")
+                 ((#:albert #:docbook #:bgcolor)   . "white")
+                 ((#:albert #:docbook #:textcolor) . "black"))
+
+    #+asdf-unicode :encoding #+asdf-unicode :utf-8
+
+    :depends-on ("com.informatimago.common-lisp.cesarum")
+
+    :components ((:file "cxx" :depends-on ())))
+
+;;;; THE END ;;;;
diff --git a/languages/cxx/cxx.lisp b/languages/cxx/cxx.lisp
index 0dac6ac..700caba 100644
--- a/languages/cxx/cxx.lisp
+++ b/languages/cxx/cxx.lisp
@@ -36,7 +36,7 @@
 ;;;;****************************************************************************

 (in-package "COMMON-LISP-USER")
-(defpackage "COM.INFORMATIMAGO.COMMON-LISP.CXX.CXX"
+(defpackage "COM.INFORMATIMAGO.LANGUAGES.CXX.CXX"
   (:use "COMMON-LISP"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.GRAPH" )
   (:export "BUILD-METHOD-CALL-GRAF" "PARSE" "C++PROGRAM")
@@ -68,7 +68,7 @@ License:
     If not, see <http://www.gnu.org/licenses/>

 "))
-(in-package "COM.INFORMATIMAGO.COMMON-LISP.CXX.CXX")
+(in-package "COM.INFORMATIMAGO.LANGUAGES.CXX.CXX")



@@ -669,7 +669,7 @@ FILE-NAME-LIST:     A list of file pathnames, C++ sources and headers."))


 #||
-(use-package          "COM.INFORMATIMAGO.COMMON-LISP.CXX.CXX")
+(use-package          "COM.INFORMATIMAGO.LANGUAGES.CXX.CXX")

 (setq source (make-instance 'File-Filter))
 (set-File source (open "/home/pascal/firms/bauhaus/hermstedt/cme_stutel/generic/CME.cpp"))
diff --git a/languages/linc/c-syntax.lisp b/languages/linc/c-syntax.lisp
index e59f4fb..7e2e2b8 100644
--- a/languages/linc/c-syntax.lisp
+++ b/languages/linc/c-syntax.lisp
@@ -159,13 +159,16 @@ Defines two functions for each KIND:
                         (symbol-package kind))))
     `(progn
        (defun ,fname (name &key external)
+         ,@(list (format nil "Declare a C ~(~A~).~%~@[~A~]" kind docstring))
          (if (listp name)
              (map nil (function ,fname) name)
              (progn
                (when external (export name (symbol-package name)))
                (setf (get name ',kind) t)))
          name)
-       (defun ,pname (name)  (get name ',kind))
+       (defun ,pname (name)
+         ,@(list (format nil "Predicate whether NAME is a C ~(~A~).~%~@[~A~]" kind docstring))
+         (get name ',kind))
        ',kind)))


@@ -242,8 +245,7 @@ BUG: Correct C number syntax!
 (defun exactly-one-p   (list) (and       list  (not (cdr   list))))
 (defun exactly-two-p   (list) (and (cdr  list) (not (cddr  list))))
 (defun exactly-three-p (list) (and (cddr list) (not (cdddr list))))
-(defun proper-list-p (list)
-  (or (endp list) (proper-list-p (rest list))))
+


 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -370,8 +372,6 @@ BUG: Correct C number syntax!
        ,@(mapcar (lambda (arg) `(when ,arg (incf ,vcount))) args)
        ,vcount)))

-(defun xor (a b) (and (or a b) (not (and a b))))
-
 (defmethod initialize-instance :after ((self 2-arguments)
                                        &rest all-init-args
                                        &key (arguments nil argumentsp)
diff --git a/languages/linc/linc.lisp b/languages/linc/linc.lisp
index 83b90b9..04efb72 100644
--- a/languages/linc/linc.lisp
+++ b/languages/linc/linc.lisp
@@ -488,19 +488,6 @@



-(defmacro handling-errors (&body body)
-  `(HANDLER-CASE (progn ,@body)
-     (simple-condition  (ERR)
-       (format *error-output* "~&~A: ~%" (class-name (class-of err)))
-       (apply (function format) *error-output*
-              (simple-condition-format-control   err)
-              (simple-condition-format-arguments err))
-       (format *error-output* "~&")
-       (finish-output))
-     (condition (ERR)
-       (format *error-output* "~&~A: ~%  ~S~%" (class-name (class-of err)) err)
-       (finish-output))))
-
 (defun repl ()
   (catch 'repl     ; allow for emergency exit with (throw 'com.informatimago.linc::repl)
     (let ((*package* (find-package "C"))
@@ -821,6 +808,8 @@ RETURN:  A destructuring-lambda-list; a literal a-list ; a variable a-list.
 ;; enum { blue=1, white, red } colors;


+(defgeneric generate (expression))
+
 (defun generate-type (expression &key name)

   (ecase (first expression)
@@ -953,7 +942,7 @@ RETURN:  A destructuring-lambda-list; a literal a-list ; a variable a-list.
      (emit "extern" " ")
      (generate-expression ?string)
      (with-parens "{}"
-       (dolist (?declaration ?declartions)
+       (dolist (?declaration ?declarations)
          (generate-declaration ?declaration)))
      (emit :newline))

@@ -961,10 +950,11 @@ RETURN:  A destructuring-lambda-list; a literal a-list ; a variable a-list.
      (error "Not a declaration: ~S" ?everything))))


+(defmethod generate ((expression t))
+  (generate-expression expression))

-(defmethod generate (expression)
-  (if (atom expression)
-    (generate-expression expression)
+(defmethod generate ((expression cons))
+
     (let ((key (first expression)))
       (ecase key

@@ -1044,7 +1034,7 @@ RETURN:  A destructuring-lambda-list; a literal a-list ; a variable a-list.
            com.informatimago.linc.c::scope
            com.informatimago.linc.c::literal
            com.informatimago.linc.c::identifier)
-         (generate-expression expression))))))
+         (generate-expression expression)))))

 ;; (class (scope Configuration Exception InvalidFieldException))

@@ -1072,14 +1062,15 @@ RETURN:  A destructuring-lambda-list; a literal a-list ; a variable a-list.
         ((\#cond)
          (let ((op "#if"))
            (dolist (clause clauses)
-             (if (find (first clause) '(t (quote t)) :test (function equal))
-               (emit :fresh-line "#else" :newline)
-               (progn (emit :fresh-line op " ")
-                      (generate-expression (first clauses))
-                      (emit :newline)
-                      (setf op "#elif")))
-             (dolist (item (rest clauses))
-               (generate item)))))
+             (destructuring-bind (condi &rest body) clause
+              (if (find condi '(t (quote t)) :test (function equal))
+                  (emit :fresh-line "#else" :newline)
+                  (progn (emit :fresh-line op " ")
+                         (generate-expression condi)
+                         (emit :newline)
+                         (setf op "#elif")))
+              (dolist (item body)
+                (generate item))))))

         ((\#if \#ifdef \#ifndef)
          (destructuring-bind (\#test ?condition ?then &optional ?else) expression
@@ -1093,7 +1084,7 @@ RETURN:  A destructuring-lambda-list; a literal a-list ; a variable a-list.
            (emit :fresh-line "#endif" :newline)))

         ((\#define)
-         (destructuring-bind (?operator ?name &rest ?arguments)
+         (destructuring-bind (?operator ?name &rest ?arguments) expression
              (if (listp ?name)
                (in-continuation-lines
                 (emit "#define" " " (first ?name))
diff --git a/languages/lua/com.informatimago.languages.lua.asd b/languages/lua/com.informatimago.languages.lua.asd
new file mode 100644
index 0000000..4bd8021
--- /dev/null
+++ b/languages/lua/com.informatimago.languages.lua.asd
@@ -0,0 +1,78 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               com.informatimago.lua.asd
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Defines the com.informatimago.lua system.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2012-02-24 <PJB> Added this header.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2012 - 2012
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see http://www.gnu.org/licenses/
+;;;;**************************************************************************
+
+(asdf:defsystem :com.informatimago.languages.lua
+
+    ;; system attributes:
+
+    :description "LUA Scanner and Parser."
+
+    :long-description "
+This system provides tools to manipulate LUA programs.
+- A LUA Scanner.
+- A LUA Parser.
+- (eventually, possibly a LUA interpreter or translator to CL).
+"
+
+    :author     "Pascal Bourguignon <pjb@informatimago.com>"
+
+    :maintainer "Pascal Bourguignon <pjb@informatimago.com>"
+
+    :licence "AGPL3"
+
+    ;; component attributes:
+
+    :name "LUA Tools."
+
+    :version "1.0.0"
+
+    :properties ((#:author-email                   . "pjb@informatimago.com")
+                 (#:date                           . "Summer 2012")
+                 ((#:albert #:output-dir)          . "../documentation/com.informatimago.lua/")
+                 ((#:albert #:formats)             . ("docbook"))
+                 ((#:albert #:docbook #:template)  . "book")
+                 ((#:albert #:docbook #:bgcolor)   . "white")
+                 ((#:albert #:docbook #:textcolor) . "black"))
+
+    #+asdf-unicode :encoding #+asdf-unicode :utf-8
+
+    :depends-on ("com.informatimago.common-lisp.cesarum"
+                 "com.informatimago.common-lisp.parser"
+                 "com.informatimago.rdp")
+
+    :components ((:file "package")
+                 (:file "lua-scanner" :depends-on ("package"))
+                 (:file "lua-parser"  :depends-on ("package" "lua-scanner"))))
+
+;;;; THE END ;;;;
diff --git a/languages/lua/com.informatimago.lua.asd b/languages/lua/com.informatimago.lua.asd
deleted file mode 100644
index 0d05c33..0000000
--- a/languages/lua/com.informatimago.lua.asd
+++ /dev/null
@@ -1,78 +0,0 @@
-;;;; -*- mode:lisp;coding:utf-8 -*-
-;;;;**************************************************************************
-;;;;FILE:               com.informatimago.lua.asd
-;;;;LANGUAGE:           Common-Lisp
-;;;;SYSTEM:             Common-Lisp
-;;;;USER-INTERFACE:     NONE
-;;;;DESCRIPTION
-;;;;
-;;;;    Defines the com.informatimago.lua system.
-;;;;
-;;;;AUTHORS
-;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
-;;;;MODIFICATIONS
-;;;;    2012-02-24 <PJB> Added this header.
-;;;;BUGS
-;;;;LEGAL
-;;;;    AGPL3
-;;;;
-;;;;    Copyright Pascal J. Bourguignon 2012 - 2012
-;;;;
-;;;;    This program is free software: you can redistribute it and/or modify
-;;;;    it under the terms of the GNU Affero General Public License as published by
-;;;;    the Free Software Foundation, either version 3 of the License, or
-;;;;    (at your option) any later version.
-;;;;
-;;;;    This program is distributed in the hope that it will be useful,
-;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;;    GNU Affero General Public License for more details.
-;;;;
-;;;;    You should have received a copy of the GNU Affero General Public License
-;;;;    along with this program.  If not, see http://www.gnu.org/licenses/
-;;;;**************************************************************************
-
-(asdf:defsystem :com.informatimago.lua
-
-    ;; system attributes:
-
-    :description "LUA Scanner and Parser."
-
-    :long-description "
-This system provides tools to manipulate LUA programs.
-- A LUA Scanner.
-- A LUA Parser.
-- (eventually, possibly a LUA interpreter or translator to CL).
-"
-
-    :author     "Pascal Bourguignon <pjb@informatimago.com>"
-
-    :maintainer "Pascal Bourguignon <pjb@informatimago.com>"
-
-    :licence "AGPL3"
-
-    ;; component attributes:
-
-    :name "LUA Tools."
-
-    :version "1.0.0"
-
-    :properties ((#:author-email                   . "pjb@informatimago.com")
-                 (#:date                           . "Summer 2012")
-                 ((#:albert #:output-dir)          . "../documentation/com.informatimago.lua/")
-                 ((#:albert #:formats)             . ("docbook"))
-                 ((#:albert #:docbook #:template)  . "book")
-                 ((#:albert #:docbook #:bgcolor)   . "white")
-                 ((#:albert #:docbook #:textcolor) . "black"))
-
-    #+asdf-unicode :encoding #+asdf-unicode :utf-8
-
-    :depends-on ("com.informatimago.common-lisp.cesarum"
-                 "com.informatimago.common-lisp.parser"
-                 "com.informatimago.rdp")
-
-    :components ((:file "package")
-                 (:file "lua-scanner" :depends-on ("package"))
-                 (:file "lua-parser"  :depends-on ("package" "lua-scanner"))))
-
-;;;; THE END ;;;;
diff --git a/languages/lua/lua-parser.lisp b/languages/lua/lua-parser.lisp
index be217b4..d4ef665 100644
--- a/languages/lua/lua-parser.lisp
+++ b/languages/lua/lua-parser.lisp
@@ -14,6 +14,9 @@
 ;;;;MODIFICATIONS
 ;;;;    2012-07-15 <PJB> Created.
 ;;;;BUGS
+;;;;
+;;;;    This is unfinished.
+;;;;
 ;;;;LEGAL
 ;;;;    AGPL3
 ;;;;
@@ -33,7 +36,7 @@
 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
 ;;;;**************************************************************************

-(in-package "COM.INFORMATIMAGO.LUA.PARSER")
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LUA.PARSER")


 (defgrammar lua
@@ -62,11 +65,19 @@
                       (seq "while" exp "do" block "end")
                       (seq "repeat" block "until" exp)
                       (seq "if" exp "then" block (rep "elseif" exp "then" block) (opt "else" block) "end")
-                      (seq "for" Name "=" exp "," exp (opt "," exp) "do" block "end")
-                      (seq "for" namelist "in" explist "do" block "end")
-                      (seq "function" funcname funcbody)
-                      (seq "local" "function" Name funcbody)
-                      (seq "local" namelist (opt "=" explist))))
+
+                      (seq "for" Name (alt for-name-=
+                                           for-namelist))
+
+                      (seq "function" funcname funcbody)
+                      (seq "local"
+                           (alt (seq "function" Name funcbody)
+                                (seq namelist (opt "=" explist))))))
+
+            (--> for-name-=
+                 (seq "=" exp "," exp (opt "," exp) "do" block "end"))
+            (--> for-namelist
+                 (seq namelist-cont "in" explist "do" block "end"))

             (--> retstat
                  (seq "return" (opt explist) (opt ";")))
@@ -81,7 +92,10 @@
                  (seq var (rep (seq "," var))))

             (--> namelist
-                 (seq Name (rep (seq "," Name))))
+                 (seq Name namelist-cont))
+
+            (--> namelist-cont
+                 (rep (seq "," Name)))

             (--> explist
                  (seq exp (rep (seq "," exp))))
@@ -153,17 +167,25 @@
             (--> indexpart
                  (alt (seq "[" exp "]")
                       (seq "." Name)))
-
+
+            #-(and)
             (--> prefixexp
                  (alt
                   (seq (alt Name
                             (seq "(" exp ")"))
                        (rep (alt callpart
                                  indexpart)))))
+            ;; TODO:
+            (--> prefixexp
+                 "prefix")
+
+            ;; TODO:
             (--> var
-                 )
+                 Name)
+
+            ;; TODO:
             (--> functioncall
-                 )
+                 (seq "funcall" Name "(" exp ")"))



diff --git a/languages/lua/lua-scanner.lisp b/languages/lua/lua-scanner.lisp
index a048bbc..dabba1b 100644
--- a/languages/lua/lua-scanner.lisp
+++ b/languages/lua/lua-scanner.lisp
@@ -42,7 +42,7 @@
 ;;;;**************************************************************************


-(in-package "COM.INFORMATIMAGO.LUA.SCANNER")
+(in-package "COM.INFORMATIMAGO.LANGUAGES.LUA.SCANNER")


 ;; We need to write a specific scanner because of long brackets. :-(
diff --git a/languages/lua/package.lisp b/languages/lua/package.lisp
index cb4ea35..6ce7872 100644
--- a/languages/lua/package.lisp
+++ b/languages/lua/package.lisp
@@ -35,7 +35,7 @@

 (in-package "COMMON-LISP-USER")

-(defpackage "COM.INFORMATIMAGO.LUA.SCANNER"
+(defpackage "COM.INFORMATIMAGO.LANGUAGES.LUA.SCANNER"
   (:use "COMMON-LISP"
         "COM.INFORMATIMAGO.COMMON-LISP.PARSER.SCANNER")
   (:export
@@ -69,10 +69,10 @@ License, or (at your option) any later version.



-(defpackage "COM.INFORMATIMAGO.LUA.PARSER"
+(defpackage "COM.INFORMATIMAGO.LANGUAGES.LUA.PARSER"
   (:use "COMMON-LISP"
         "COM.INFORMATIMAGO.COMMON-LISP.PARSER.SCANNER"
-        "COM.INFORMATIMAGO.LUA.SCANNER"
+        "COM.INFORMATIMAGO.LANGUAGES.LUA.SCANNER"
         "COM.INFORMATIMAGO.RDP")
   (:export
    )
diff --git a/rdp/com.informatimago.rdp.asd b/rdp/com.informatimago.rdp.asd
index e15a043..7ce6eb2 100644
--- a/rdp/com.informatimago.rdp.asd
+++ b/rdp/com.informatimago.rdp.asd
@@ -72,8 +72,9 @@ different languages than lisp.
                  "com.informatimago.common-lisp.cesarum"
                  "com.informatimago.common-lisp.parser")

-    :components ((:file "rdp")
-                 (:file "rdp-lisp-boilerplate" :depends-on ("rdp"))
-                 (:file "rdp-macro"            :depends-on ("rdp"))))
+    :components ((:file "packages")
+                 (:file "rdp"                  :depends-on ("packages"))
+                 (:file "rdp-lisp-boilerplate" :depends-on ("packages" "rdp"))
+                 (:file "rdp-macro"            :depends-on ("packages" "rdp"))))

 ;;;; THE END ;;;;
diff --git a/rdp/example-lisp.lisp b/rdp/example-lisp.lisp
index 4395fe1..27480c0 100644
--- a/rdp/example-lisp.lisp
+++ b/rdp/example-lisp.lisp
@@ -129,7 +129,20 @@ begin
     b:=30.0;
     call gcd
 end.")
-               '(block (((ident "abc" 11) (integer "123" 17)) ((ident "pi" 32) (real "3.141592e+0" 35))) ((ident "a" 57) (ident "b" 59) (ident "c" 61)) ((procedure (ident "gcd" 79) (block nil nil nil ((while (("#" "#" 112) (+ ((ident "a" 110))) (+ ((ident "b" 114)))) ((if (("<" "<" 151) (+ ((ident "a" 150))) (+ ((ident "b" 152)))) (setf (ident "b" 159) (+ ((ident "b" 162)) (("-" "-" 163) ((ident "a" 164)))))) (if ((">" ">" 186) (+ ((ident "a" 185))) (+ ((ident "b" 187)))) (setf (ident "a" 194) (+ ((ident "a" 197)) (("-" "-" 198) ((ident "b" 199)))))))))))) ((setf (ident "a" 235) (+ ((integer "42" 238)))) (setf (ident "b" 246) (+ ((real "30.0" 249)))) (call (ident "gcd" 264))))))
+
+               '(block (((ident "abc" 14) (integer "123" 20)) ((ident "pi" 13) (real "3.141592e+0" 25)))
+                 ((ident "a" 10) (ident "b" 12) (ident "c" 14))
+                 ((procedure (ident "gcd" 18)
+                   (block nil
+                     nil
+                     nil
+                     ((((while ((#1="#" #1# 18) (+ ((ident "a" 16))) (+ ((ident "b" 20))))
+                          ((((if ((#2="<" #2# 19) (+ ((ident "a" 18))) (+ ((ident "b" 20))))
+                                 ((setf (ident "b" 27) (+ ((ident "b" 30)) ((#3="-" #3# 31) ((ident "a" 32))))))))
+                            ((if ((#4=">" #4# 19) (+ ((ident "a" 18))) (+ ((ident "b" 20))))
+                                 ((setf (ident "a" 27) (+ ((ident "a" 30)) ((#5="-" #5# 31) ((ident "b" 32)))))))))))))))))
+                 ((((setf (ident "a" 6) (+ ((integer "42" 10))))) ((setf (ident "b" 6) (+ ((real "30.0" 12)))))
+                   ((call (ident "gcd" 13))))))))



@@ -196,7 +209,62 @@ begin
     b:=30.0;
     call gcd
 end.")
-               '(program (block (("const" "const" 5) (ident "abc" 11) ("=" "=" 15) (number (integer "123" 17)) ((("," "," 20) (ident "pi" 32) ("=" "=" 34) (number (real "3.141592e+0" 35)))) (";" ";" 46)) (("var" "var" 53) (ident "a" 57) ((("," "," 58) (ident "b" 59)) (("," "," 60) (ident "c" 61))) (";" ";" 62)) ((("procedure" "procedure" 69) (ident "gcd" 79) (";" ";" 82) (block nil nil nil (statement (("begin" "begin" 89) (statement (("while" "while" 104) (condition ((expression nil (term (factor (ident "a" 110)) nil) nil) ("#" "#" 112) (expression nil (term (factor (ident "b" 114)) nil) nil))) ("do" "do" 116) (statement (("begin" "begin" 128) (statement (("if" "if" 147) (condition ((expression nil (term (factor (ident "a" 150)) nil) nil) ("<" "<" 151) (expression nil (term (factor (ident "b" 152)) nil) nil))) ("then" "then" 154) (statement ((ident "b" 159) (":=" ":=" 160) (expression nil (term (factor (ident "b" 162)) nil) ((("-" "-" 163) (term (factor (ident "a" 164)) nil)))))))) (((";" ";" 166) (statement (("if" "if" 182) (condition ((expression nil (term (factor (ident "a" 185)) nil) nil) (">" ">" 186) (expression nil (term (factor (ident "b" 187)) nil) nil))) ("then" "then" 189) (statement ((ident "a" 194) (":=" ":=" 195) (expression nil (term (factor (ident "a" 197)) nil) ((("-" "-" 198) (term (factor (ident "b" 199)) nil)))))))))) ("end" "end" 210))))) nil ("end" "end" 219)))) (";" ";" 222))) (statement (("begin" "begin" 224) (statement ((ident "a" 235) (":=" ":=" 236) (expression nil (term (factor (number (integer "42" 238))) nil) nil))) (((";" ";" 240) (statement ((ident "b" 246) (":=" ":=" 247) (expression nil (term (factor (number (real "30.0" 249))) nil) nil)))) ((";" ";" 253) (statement (("call" "call" 259) (ident "gcd" 264))))) ("end" "end" 268)))) ("." "." 271))))
+
+               '(program
+                 (block
+                     (("const" "const" 5) (ident "abc" 11) ("=" "=" 15) (number (integer "123" 17))
+                      ((("," "," 20) (ident "pi" 32) ("=" "=" 34) (number (real "3.141592e+0" 35)))) (";" ";" 46))
+                   (("var" "var" 53) (ident "a" 57) ((("," "," 58) (ident "b" 59)) (("," "," 60) (ident "c" 61)))
+                    (";" ";" 62))
+                   ((("procedure" "procedure" 69) (ident "gcd" 79) (";" ";" 82)
+                     (block nil
+                       nil
+                       nil
+                       (statement
+                        (("begin" "begin" 89)
+                         (statement
+                          (("while" "while" 104)
+                           (condition
+                            ((expression nil (term (factor (ident "a" 110)) nil) nil) ("#" "#" 112)
+                             (expression nil (term (factor (ident "b" 114)) nil) nil)))
+                           ("do" "do" 116)
+                           (statement
+                            (("begin" "begin" 128)
+                             (statement
+                              (("if" "if" 147)
+                               (condition
+                                ((expression nil (term (factor (ident "a" 150)) nil) nil) ("<" "<" 151)
+                                 (expression nil (term (factor (ident "b" 152)) nil) nil)))
+                               ("then" "then" 154)
+                               (statement
+                                ((ident "b" 159) (":=" ":=" 160)
+                                 (expression nil (term (factor (ident "b" 162)) nil)
+                                             ((("-" "-" 163) (term (factor (ident "a" 164)) nil))))))))
+                             (((";" ";" 166)
+                               (statement
+                                (("if" "if" 182)
+                                 (condition
+                                  ((expression nil (term (factor (ident "a" 185)) nil) nil) (">" ">" 186)
+                                   (expression nil (term (factor (ident "b" 187)) nil) nil)))
+                                 ("then" "then" 189)
+                                 (statement
+                                  ((ident "a" 194) (":=" ":=" 195)
+                                   (expression nil (term (factor (ident "a" 197)) nil)
+                                               ((("-" "-" 198) (term (factor (ident "b" 199)) nil))))))))))
+                             ("end" "end" 210)))))
+                         nil ("end" "end" 219))))
+                     (";" ";" 222)))
+                   (statement
+                    (("begin" "begin" 224)
+                     (statement
+                      ((ident "a" 235) (":=" ":=" 236) (expression nil (term (factor (number (integer "42" 238))) nil) nil)))
+                     (((";" ";" 240)
+                       (statement
+                        ((ident "b" 246) (":=" ":=" 247)
+                         (expression nil (term (factor (number (real "30.0" 249))) nil) nil))))
+                      ((";" ";" 253) (statement (("call" "call" 259) (ident "gcd" 264)))))
+                     ("end" "end" 268))))
+                 ("." "." 271))))


 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/rdp/packages.lisp b/rdp/packages.lisp
new file mode 100644
index 0000000..f52a33e
--- /dev/null
+++ b/rdp/packages.lisp
@@ -0,0 +1,101 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               packages.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Define the rdp package.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2013-06-16 <PJB> Extracted defpackage form.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2013 - 2013
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(eval-when (:execute :compile-toplevel :load-toplevel)
+  (setf *features* (cons :use-ppcre (set-difference *features* '(:use-ppcre :use-regexp)))))
+
+(defpackage "COM.INFORMATIMAGO.RDP"
+  (:use "COMMON-LISP"
+        ;; "CL-STEPPER"
+        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SEQUENCE"
+        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.CONSTRAINTS"
+        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.PEEK-STREAM"
+        "COM.INFORMATIMAGO.COMMON-LISP.PARSER.SCANNER"
+        ;; "COM.INFORMATIMAGO.COMMON-LISP.PARSER.PARSER"
+        )
+  (:export "DEFGRAMMAR" "SEQ" "REP" "OPT" "ALT" "GRAMMAR-NAMED"
+           "GENERATE-GRAMMAR"
+
+           "GRAMMAR" "MAKE-GRAMMAR" "COPY-GRAMMAR"
+           "GRAMMAR-NAME" "GRAMMAR-TERMINALS" "GRAMMAR-START" "GRAMMAR-RULES"
+           "GRAMMAR-ALL-TERMINALS" "GRAMMAR-ALL-NON-TERMINALS"
+           "GRAMMAR-SKIP-SPACES"
+
+           "FIND-RULE" "TERMINALP" "NON-TERMINAL-P"
+           "FIRST-SET" "FOLLOW-SET" "NULLABLEP"
+
+           "CLEAN-RULES"
+           "NORMALIZE-GRAMMAR" "COMPUTE-FIRST-SETS" "COMPUTE-FOLLOW-SETS"
+
+           "$0"
+
+           "*NON-TERMINAL-STACK*"
+           ;; Re-export form com.informatimago.common-lisp.parser.scanner:
+           "TOKEN" "TOKEN-KIND" "TOKEN-TEXT" "TOKEN-LINE" "TOKEN-COLUMN"
+           "*SPACE*" "WORD-EQUAL"
+           "RDP-SCANNER"
+           "SCANNER-LINE" "SCANNER-COLUMN" "SCANNER-STATE" "SCANNER-CURRENT-TOKEN"
+           "SCANNER-SPACES" "SCANNER-TAB-WIDTH"
+           "SKIP-SPACES" "SCAN-NEXT-TOKEN"
+           "SCANNER-BUFFER" "SCANNER-CURRENT-TEXT"
+           "SCANNER-END-OF-SOURCE-P" "ADVANCE-LINE" "ACCEPT"
+           "PARSER-ERROR"
+           "PARSER-ERROR-LINE"
+           "PARSER-ERROR-COLUMN"
+           "PARSER-ERROR-GRAMMAR"
+           "PARSER-ERROR-SCANNER"
+           "PARSER-ERROR-NON-TERMINAL-STACK"
+           "PARSER-ERROR-FORMAT-CONTROL"
+           "PARSER-ERROR-FORMAT-ARGUMENTS"
+           "PARSER-END-OF-SOURCE-NOT-REACHED"
+           ;; "PARSER-ERROR-UNEXPECTED-TOKEN"
+           ;; "PARSER-ERROR-EXPECTED-TOKEN"
+           "UNEXPECTED-TOKEN-ERROR"
+           "UNEXPECTED-TOKEN-ERROR-EXPECTED-TOKEN"
+           "UNEXPECTED-TOKEN-ERROR-NON-TERMINAL-STACK"
+           )
+  (:documentation "
+This package implements a simple recursive descent parser.
+
+Copyright Pascal Bourguignon 2006 - 2012
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Affero General Public License as
+published by the Free Software Foundation, either version 3 of the
+License, or (at your option) any later version.
+"))
+
+
+
+;;;; THE END ;;;;
diff --git a/rdp/rdp-lisp-boilerplate.lisp b/rdp/rdp-lisp-boilerplate.lisp
index 04777d7..a378cb6 100644
--- a/rdp/rdp-lisp-boilerplate.lisp
+++ b/rdp/rdp-lisp-boilerplate.lisp
@@ -39,6 +39,14 @@
 (defvar *non-terminal-stack* '()
   "For error reporting.")

+(defgeneric print-parser-error  (error stream))
+(defgeneric print-scanner-error (error stream))
+(defgeneric scanner-end-of-line-p   (scanner))
+(defgeneric scanner-end-of-source-p (scanner))
+(defgeneric advance-line            (scanner))
+(defgeneric accept                  (scanner token))
+
+
 (define-condition parser-error (error)
   ((line    :initarg :line    :initform 1   :reader parser-error-line)
    (column  :initarg :column  :initform 0   :reader parser-error-column)
diff --git a/rdp/rdp.lisp b/rdp/rdp.lisp
index 5ab4037..71fabba 100644
--- a/rdp/rdp.lisp
+++ b/rdp/rdp.lisp
@@ -48,76 +48,8 @@
 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>
 ;;;;**************************************************************************

-(in-package "COMMON-LISP-USER")
-
-(eval-when (:execute :compile-toplevel :load-toplevel)
-  (setf *features* (cons :use-ppcre (set-difference *features* '(:use-ppcre :use-regexp)))))
-
-
-(defpackage "COM.INFORMATIMAGO.RDP"
-  (:use "COMMON-LISP"
-        ;; "CL-STEPPER"
-        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SEQUENCE"
-        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.CONSTRAINTS"
-        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.PEEK-STREAM"
-        "COM.INFORMATIMAGO.COMMON-LISP.PARSER.SCANNER"
-        ;; "COM.INFORMATIMAGO.COMMON-LISP.PARSER.PARSER"
-        )
-  (:export "DEFGRAMMAR" "SEQ" "REP" "OPT" "ALT" "GRAMMAR-NAMED"
-           "GENERATE-GRAMMAR"
-
-           "GRAMMAR" "MAKE-GRAMMAR" "COPY-GRAMMAR"
-           "GRAMMAR-NAME" "GRAMMAR-TERMINALS" "GRAMMAR-START" "GRAMMAR-RULES"
-           "GRAMMAR-ALL-TERMINALS" "GRAMMAR-ALL-NON-TERMINALS"
-           "GRAMMAR-SKIP-SPACES"
-
-           "FIND-RULE" "TERMINALP" "NON-TERMINAL-P"
-           "FIRST-SET" "FOLLOW-SET" "NULLABLEP"
-
-           "CLEAN-RULES"
-           "NORMALIZE-GRAMMAR" "COMPUTE-FIRST-SETS" "COMPUTE-FOLLOW-SETS"
-
-           "$0"
-
-           "*NON-TERMINAL-STACK*"
-           ;; Re-export form com.informatimago.common-lisp.parser.scanner:
-           "TOKEN" "TOKEN-KIND" "TOKEN-TEXT" "TOKEN-LINE" "TOKEN-COLUMN"
-           "*SPACE*" "WORD-EQUAL"
-           "RDP-SCANNER"
-           "SCANNER-LINE" "SCANNER-COLUMN" "SCANNER-STATE" "SCANNER-CURRENT-TOKEN"
-           "SCANNER-SPACES" "SCANNER-TAB-WIDTH"
-           "SKIP-SPACES" "SCAN-NEXT-TOKEN"
-           "SCANNER-BUFFER" "SCANNER-CURRENT-TEXT"
-           "SCANNER-END-OF-SOURCE-P" "ADVANCE-LINE" "ACCEPT"
-           "PARSER-ERROR"
-           "PARSER-ERROR-LINE"
-           "PARSER-ERROR-COLUMN"
-           "PARSER-ERROR-GRAMMAR"
-           "PARSER-ERROR-SCANNER"
-           "PARSER-ERROR-NON-TERMINAL-STACK"
-           "PARSER-ERROR-FORMAT-CONTROL"
-           "PARSER-ERROR-FORMAT-ARGUMENTS"
-           "PARSER-END-OF-SOURCE-NOT-REACHED"
-           ;; "PARSER-ERROR-UNEXPECTED-TOKEN"
-           ;; "PARSER-ERROR-EXPECTED-TOKEN"
-           "UNEXPECTED-TOKEN-ERROR"
-           "UNEXPECTED-TOKEN-ERROR-EXPECTED-TOKEN"
-           "UNEXPECTED-TOKEN-ERROR-NON-TERMINAL-STACK"
-           )
-  (:documentation "
-This package implements a simple recursive descent parser.
-
-Copyright Pascal Bourguignon 2006 - 2012
-
-This program is free software: you can redistribute it and/or modify
-it under the terms of the GNU Affero General Public License as
-published by the Free Software Foundation, either version 3 of the
-License, or (at your option) any later version.
-"))
 (in-package "COM.INFORMATIMAGO.RDP")

-
-
 (defstruct (grammar
              (:print-function
               (cl:lambda (object stream depth)
@@ -987,6 +919,12 @@ RETURN:  When the SEQUENCE is a vector, the SEQUENCE itself, or a dispaced
      ,@body))


+(defgeneric gen-scanner-function-name (target grammar))
+(defgeneric gen-scanner-class-name    (target grammar))
+(defgeneric gen-parse-function-name   (target grammar non-terminal))
+(defgeneric gen-in-firsts             (target firsts))
+(defgeneric gen-parsing-statement     (target grammar item))
+
 (defmethod gen-scanner-function-name ((target (eql :lisp)) (grammar grammar))
   (intern (format nil "~:@(SCAN-~A~)" (grammar-name grammar))))

@@ -1073,6 +1011,7 @@ RETURN:  When the SEQUENCE is a vector, the SEQUENCE itself, or a dispaced
                                (advance-line scanner))
                               ;; Literal Alpha Numeric and Non Alpha Numeric Terminals:
                               ,@(when (or an-terminals nan-terminals)
+                                      ;; (print (list an-terminals nan-terminals))
                                       `(((or ,@(when an-terminals
                                                      `((setf match (string-match ',lit-an-terminals-regexp
                                                                                  (scanner-buffer scanner)
@@ -1088,6 +1027,7 @@ RETURN:  When the SEQUENCE is a vector, the SEQUENCE itself, or a dispaced
                               ;; Non Literal Terminals: we have a regexp for each terminal.
                               ,@(mapcar
                                  (lambda (terminal)
+                                   ;; (print terminal)
                                    `(,(if (= 4 (length terminal))
                                           ;; (terminal-name match-regexp / exclude-regexp)
                                           `(and (setf match (string-match
@@ -1267,7 +1207,7 @@ RETURN:  When the SEQUENCE is a vector, the SEQUENCE itself, or a dispaced
                    ,(format nil "~S" (assoc non-terminal (grammar-rules grammar)))
                    (with-non-terminal ,non-terminal
                        ,(gen-parsing-statement target grammar (find-rule grammar non-terminal))))))
-    (gen-trace fname form trace)))
+    (gen-trace fname `(progn (fmakunbound ',fname) ,form) trace)))


 (defmethod generate-parser ((target (eql :lisp)) grammar &key (trace nil))
@@ -1293,7 +1233,7 @@ SOURCE: When the grammar has a scanner generated, or a scanner class
                                    :grammar (grammar-named ',(grammar-name grammar))
                                    :scanner scanner
                                    :non-terminal-stack (copy-list *non-terminal-stack*)))))))))
-    (gen-trace fname form trace)))
+    (gen-trace fname `(progn (fmakunbound ',fname) ,form) trace)))



diff --git a/test-all-systems.lisp b/test-all-systems.lisp
new file mode 100644
index 0000000..007c4c4
--- /dev/null
+++ b/test-all-systems.lisp
@@ -0,0 +1,58 @@
+(ql:register-local-projects)
+
+(defparameter *systems*
+  '(
+    :com.informatimago.xcode
+    :com.informatimago.rdp.example
+    :com.informatimago.rdp.basic.example
+    :com.informatimago.rdp.basic
+    :com.informatimago.rdp
+    :com.informatimago.lispdoc
+    :com.informatimago.linc
+    :com.informatimago.languages.lua
+    :com.informatimago.languages.cxx
+    :com.informatimago.common-lisp.unix
+    :com.informatimago.common-lisp.tools.make-depends
+    :com.informatimago.common-lisp.telnet
+    :com.informatimago.common-lisp.rfc3548
+    :com.informatimago.common-lisp.rfc2822
+    :com.informatimago.common-lisp.regexp
+    :com.informatimago.common-lisp.picture
+    :com.informatimago.common-lisp.parser
+    :com.informatimago.common-lisp.lisp.stepper
+    :com.informatimago.common-lisp.lisp.ibcl
+    :com.informatimago.common-lisp.lisp-text
+    :com.informatimago.common-lisp.lisp-sexp
+    :com.informatimago.common-lisp.lisp-reader
+    :com.informatimago.common-lisp.lisp
+    :com.informatimago.common-lisp.invoice
+    :com.informatimago.common-lisp.interactive
+    :com.informatimago.common-lisp.http
+    :com.informatimago.common-lisp.html-parser
+    :com.informatimago.common-lisp.html-generator
+    :com.informatimago.common-lisp.html-base
+    :com.informatimago.common-lisp.heap
+    :com.informatimago.common-lisp.graphviz
+    :com.informatimago.common-lisp.ed
+    :com.informatimago.common-lisp.diagram
+    :com.informatimago.common-lisp.data-encoding
+    :com.informatimago.common-lisp.csv
+    :com.informatimago.common-lisp.cesarum
+    :com.informatimago.common-lisp.bank
+    :com.informatimago.common-lisp.arithmetic
+    :com.informatimago.common-lisp.apple-file
+    :com.informatimago.common-lisp
+    :com.informatimago.clmisc
+    #-sbcl               :com.informatimago.clext
+    #+clisp              :com.informatimago.susv3
+    #+clisp              :com.informatimago.clisp
+    #+(and ccl darwin)   :com.informatimago.objcl            ; macosx even.
+    #+(and ccl darwin)   :com.informatimago.cocoa-playground ; macosx even.
+    ))
+
+(dolist (sys *systems*)
+  (handler-case
+   (ql:quickload sys :verbose t)
+    (error (err)
+      (format t "~2%Error while loading system ~A~%~A~%" sys err))))
+
diff --git a/tools/com.informatimago.common-lisp.tools.make-depends.asd b/tools/com.informatimago.common-lisp.tools.make-depends.asd
index bc62196..2e092a2 100644
--- a/tools/com.informatimago.common-lisp.tools.make-depends.asd
+++ b/tools/com.informatimago.common-lisp.tools.make-depends.asd
@@ -70,7 +70,8 @@ translations and ad-hoc processing.
     #+asdf-unicode :encoding #+asdf-unicode :utf-8

     :depends-on ("com.informatimago.common-lisp.cesarum"
-                 "com.informatimago.common-lisp.html-generator")
+                 "com.informatimago.common-lisp.html-generator"
+                 "com.informatimago.clext")

     :components ((:file "make-depends" :depends-on ())))

diff --git a/tools/make-depends.lisp b/tools/make-depends.lisp
index be7654a..bf9d44a 100644
--- a/tools/make-depends.lisp
+++ b/tools/make-depends.lisp
@@ -58,7 +58,8 @@
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.CHARACTER-SETS"
-        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.FILE")
+        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.FILE"
+        "COM.INFORMATIMAGO.CLEXT.CHARACTER-SETS")
   (:export
    "GENERATE-SUMMARY" "MAKE-COMPONENTS" "MAKE-ASD-SEXP" "GENERATE-ASD"
    "GET-CLOSED-DEPENDENCIES" "GET-DEPENDENCIES" "GET-PACKAGE" "GET-DEPENDS"
@@ -559,14 +560,15 @@ NOTE:   Reading stops as soon as a non-comment line is read.
                 (when cont (push (clean cont) asso))
                 (return (values (nreverse asso) line))))
         ;; cleanup:
-        #+clisp (setf custom:*misc-encoding* saved)))))
+        #+clisp (setf custom:*misc-encoding* saved)
+        #-clisp nil))))



 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Reading the source files

-
+#+#:old
 (defmacro define-package (name &rest declarations)
   "
 DO:         Declares a package.
@@ -576,7 +578,7 @@ DO:         Declares a package.
 "
   (setq name (string name))
   (multiple-value-bind (dependencies renames defpack-args)
-      (package::parse-package-declarations declarations)
+      (com.informatimago.common-lisp.cesarum.package::parse-package-declarations declarations)
     (let* ((used-packages
             (nconc
              (reduce (function nconc)
@@ -589,7 +591,7 @@ DO:         Declares a package.
                                                :key (function first)))))
            (also-use-packages
             (set-difference
-             (remove-if (function package::built-in-p) dependencies)
+             (remove-if (function com.informatimago.common-lisp.cesarum.package::built-in-p) dependencies)
              used-packages :test (function string=))))
       `(progn
          ;; (in-package "COMMON-LISP-USER") ; this is useless here.
@@ -600,7 +602,7 @@ DO:         Declares a package.
          ,@(when renames
                  `((eval-when (:compile-toplevel :load-toplevel :execute)
                       ,@(mapcar
-                         (lambda (rename) `(package:add-nickname
+                         (lambda (rename) `(com.informatimago.common-lisp.cesarum.package:add-nickname
                                             ,(car rename) ,(cdr rename)))
                          renames))))
          (defpackage ,name ,@defpack-args)
@@ -613,7 +615,6 @@ DO:         Declares a package.
 ;; defpackage ...
 ;; in-package x

-;; define-package
 ;; added nicknames
 ;; defpackage
 ;; require
@@ -665,10 +666,8 @@ BUGS:   This should be rewritten using COM.INFORMATIMAGO.COMMON-LISP.SOURCE
                                              (process-sexp item)))
                  ((eval-when)              (dolist (item (cddr sexp))
                                              (process-sexp item)))
-                 ((package:add-nickname)   (push (cdr sexp) nicknames))
-                 ((package:define-package)
-                  (process-sexp
-                   (macroexpand-1 (cons 'define-package (cdr sexp))))))))
+                 ((com.informatimago.common-lisp.cesarum.package:add-nickname)
+                  (push (cdr sexp) nicknames)))))
       (loop
          :for sexp = (read-sexp-from-file stream eof)
          :until (eql sexp eof)
@@ -1040,16 +1039,16 @@ VERBOSE:        Prints information on *TRACE-OUTPUT*.
           ;; "DICTIONARY"
           ;; "PJB-STRING"
           ;; --> LOAD-PATHS
-          (unless (member pack-name package::*built-in-packages*
+          (unless (member pack-name com.informatimago.common-lisp.cesarum.package::*built-in-packages*
                           :test (function string=))
             (let* ((src-ext   (source-extensions extensions))
-                   (pack-path (package::package-pathname pack-name))
+                   (pack-path (com.informatimago.common-lisp.cesarum.package::package-pathname pack-name))
                    (path
                     (or (find-file-with-extension   pack-path  src-ext)
                         (find-file-in-directory pack-name load-paths src-ext))))
               (pdebug "~&#    source extensions are ~S~%" src-ext)
               (pdebug "~&#    path of package   is ~S~%"
-                      (package::package-pathname pack-name))
+                      (com.informatimago.common-lisp.cesarum.package::package-pathname pack-name))
               (pdebug "~&#    path              is ~S~%" path)
               (if path
                   (progn
@@ -1246,7 +1245,7 @@ IDF:            If NIL, write the dependencies on the standard output,
                         (html:b -
                           (html:a
                               (:href (funcall repository-url
-                                              (package:package-pathname
+                                              (com.informatimago.common-lisp.cesarum.package:package-pathname
                                                (source-package-name package))))
                             (html:pcdata "~A" (source-package-name package)))))
                       (html:pre -
@@ -1457,9 +1456,9 @@ VANILLAP:  if true, then generate a simple, vanilla system.

   (mapcar (lambda  (path)  (with-open-file (in path :direction :input :if-does-not-exist :error) (cons path (header-description (read-source-header  in)))))  (directory "*.lisp"))

-  (package:load-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST")
+  (com.informatimago.common-lisp.cesarum.package:load-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST")
   (use-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST")
-  (package:load-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING")
+  (com.informatimago.common-lisp.cesarum.package:load-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING")
   (use-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING")
   (make-asd "COM.INFORMATIMAGO.COMMON-LISP" (directory "*.ilsp"))
   )
diff --git a/xcode/pbxproj.lisp b/xcode/pbxproj.lisp
index b2155b9..df9affc 100644
--- a/xcode/pbxproj.lisp
+++ b/xcode/pbxproj.lisp
@@ -197,10 +197,10 @@
 (defmethod word-equal ((a symbol) (b token)) (eql a (token-kind b)))
 (defmethod word-equal ((a token) (b symbol)) (eql (token-kind a) b))

-(when (find-method (function scanner-current-token) '()  '(rdp-scanner) nil)
-  (remove-method (function scanner-current-token) (find-method (function scanner-current-token) '()  '(rdp-scanner))))
+;; (when (find-method (function scanner-current-token) '()  '(rdp-scanner) nil)
+;;   (remove-method (function scanner-current-token) (find-method (function scanner-current-token) '()  '(rdp-scanner))))

-(defmethod accept ((scanner rdp-scanner) expected)
+(defmethod accept ((scanner pbxproj-scanner) expected)
   (let ((token (scanner-current-token scanner)))
    (if (word-equal expected token)
        (prog1 (list (token-kind token)
@@ -295,3 +295,4 @@

 ;; (read-pbxproj #P"~/works/abalone-macosx/Abalone-10.7/Abalone.xcodeproj/project.pbxproj")

+;;;; THE END ;;;;
ViewGit