anchor.diff:  ;;;;    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/>
   ;;;;**************************************************************************
  -;;;;    
  -
   (defpackage "XMLS-TOOLS"
     (:use "COMMON-LISP"
  +        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY"
           #+ccl "CCL" #-ccl "CLOS")
  -  (:export "SCASE"
  -           "CONC-SYMBOL" "MAKE-KEYWORD"
  -           "COMPUTE-CLOSURE" "TOPOLOGICAL-SORT"
  -
  -           "DEFCLASS*" "*PRINT-OBJECT-READABLY*"
  +  (:export "DEFCLASS*" "*PRINT-OBJECT-READABLY*"
              
              "DEFINE-CLASS-STRUCTURE"
              "DEFINE-LIST-STRUCTURE"
  
positive.code:   (defvar *dump-exportable-symbols-p* nil
      "Set to T to get a message with the list of the symbols defined
  by define-class-structure and define-list-structure."))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;; Extracted from com.informatimago.common-lisp.utilities et al.:
  
  (defmacro scase (keyform &rest clauses)
    "
  DO:         A CASE, but for string keys. That is, it uses STRING= as test
              insteand of the ''being the same'' test.
  "
    (let ((key (gensym "KEY")))
      `(let ((,key ,keyform))
         (cond
           ,@(mapcar (lambda (clause)
                       (if (or (eq (car clause) 'otherwise) (eq (car clause) 't))
                           `(t ,@(cdr clause))
                           `((member ,key ',(car clause) :test (function string=))
                             ,@(cdr clause))))
                     clauses)))))
  
  
  (defun make-keyword (sym)
    "
  RETURN: A new keyword with SYM as name.
  "
    (intern (string sym) (find-package "KEYWORD")))
  
  
  (defun conc-symbol (&rest args)
    "
  DO:      Concatenate the arguments and INTERN the resulting string.
  NOTE:    The last two arguments maybe :PACKAGE <a-package>
           in which case the symbol is interned into the given package
           instead of *PACKAGE*.
  "
    (let ((package *package*))
      (when (and (<= 2 (length args))
                 (eq :package (car (last args 2))))
        (setf package (car (last args))
              args (butlast args 2)))
      (intern (with-standard-io-syntax
                (apply (function concatenate) 'string
                       (mapcar (function string) args)))
              package)))
  
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  
negative.code:              include initial-offset predicate
               print-function print-object unbound
               symbols)
      (declare (ignorable initial-offset))
      (flet ((push1 (symbol) (push symbol symbols) symbol))
        (if (symbolp name-and-options)
            (setf name    name-and-options
  