anchor.diff:  ;; Current Table Management
   ;; ==========================================================================
   
  -(defvar *format-table* (make-format-table :name 'default
  -					  ;; no need to set it twice ;-)
  -					  :make-current nil)
  -  "The current format table.
  -This variable behaves as *READTABLE* and *PACKAGE* with respect to LOAD and
  -COMPILE-FILE.")
  -
  -(defmacro in-format-table (name)
  -  "Set the current format table to NAMEd table."
  +(defvar *format-table* nil
  +  "The current format table.")
  +
  +#|
  +(defmacro in-format-table (table-or-name)
  +  "Set the current format table to TABLE-OR-NAME."
     `(eval-when (:compile-toplevel :load-toplevel :execute)
  -     (setq *format-table* (find-format-table ',name))))
  -
  -(defmacro in-format-table* (table)
  -  "Set the current format table to TABLE."
  -  `(eval-when (:compile-toplevel :load-toplevel :execute)
  -     (setq *format-table* ,table)))
  -
  -(defmacro with-format-table (name &body body)
  -  "Execute BODY with current format table bound to NAMEd table."
  -  `(let ((*format-table* (find-format-table ,name)))
  +     (setq *format-table* (find-table ,table-or-name))))
  +|#
  +
  +(defmacro with-format-table (table-or-name &body body)
  +  "Execute BODY with the current format table bound to TABLE-OR-NAME."
  +  `(let ((*format-table* (find-table ,table-or-name)))
        ,@body))
   
  -(defmacro with-format-table* (table &body body)
  -  "Execute BODY with current format table bound to TABLE."
  -  `(let ((*format-table* ,table))
  -     ,@body))
  -
   
   
   ;; ==========================================================================
   ;; Table Contents Management
   ;; ==========================================================================
   
  -(define-condition format-table-directive-error (format-table-error)
  +(define-condition table-directive-error (format-table-error)
     ((character :documentation "The directive character."
  -	      :initarg :directive
  -	      :reader directive))
  -  (:documentation "A format table directive error."))
  -
  -(define-condition existing-directive (format-table-directive-error)
  -  ()
  -  (:report (lambda (error stream)
  -	     (format stream "Directive ~~~A already exists in table ~A."
  -	       (directive error)
  -	       (table-id (table error)))))
  -  (:documentation "An existing directive error."))
  -
  -(define-condition unknown-directive (format-table-directive-error)
  -  ()
  -  (:report (lambda (error stream)
  -	     (format stream "Directive ~~~A is unknown in table ~A."
  -	       (directive error)
  -	       (table-id (table error)))))
  -  (:documentation "An unknown directive error."))
  -
  -
  +	      :initarg :character
  +	      ;; The lack of polymorphism on standard functions sucks. I want
  +	      ;; to use just CHARACTER here.
  +	      :reader table-character))
  +  (:documentation "A table directive error."))
  +
  +(define-condition table-directive-collision (table-directive-error)
  +  ()
  +  (:report (lambda (error stream)
  +	     (cl:format stream "Directive ~~~A already exists in table ~A."
  +	       (table-character error)
  +	       (table error))))
  +  (:documentation "A table directive collision error."))
  +
  +#| Unused right now. We could warn the user about an attempt to remove a
  +   missing directive tho.
  +(define-condition missing-table-directive (table-directive-error)
  +  ()
  +  (:report (lambda (error stream)
  +	     (cl:format stream "There is no ~~~A directive in table ~A."
  +	       (table-character error)
  +	       (table error))))
  +  (:documentation "A missing table directive error."))
  +|#
  +
  +;; #### FIXME: should abstract the hashtable manipulation with
  +;; TABLE-DIRECTIVE and such.
   (defun set-format-directive
       (char &key standard function-name
  -	       (both-case t) force (table *format-table*)
  -	  &aux (table (find-format-table table)))
  -  "Set a CHAR directive in TABLE.
  +	       (both-case t) force ((:table table-or-name) *format-table*)
  +	  &aux (table (find-table table-or-name)))
  +  "Set a ~CHAR directive in TABLE.
   - TABLE (the current format table by default) may be a table or a table name.
   - When BOTH-CASE (the default), operate on both case versions of CHAR.
  -- Attempting to override an existing directive signals an error, unless FORCE
  -  is non-nil.
  +- Attempting to override an existing directive throws a DIRECTIVE-COLLISION
  +  error, unless FORCE is non-nil.
   
   The operation to perform is as follows:
   - If FUNCTION-NAME is provided, associate CHAR with it.
   - If STANDARD is provided, associate CHAR with the standard directive denoted
  -  by STANDARD character. Case does not matter.
  -- Otherwise, remove CHAR directive."
  +  by STANDARD character (case does not matter).
  +- Otherwise, remove the ~CHAR directive from TABLE."
     (let ((mappings (table-mappings table))
   	(other-char (when both-case (other-case char))))
       (cond ((or function-name standard)
   	   (when (and (gethash char mappings) (not force))
  -	     (error 'existing-directive :directive char :table table))
  +	     (error 'table-directive-collision
  +	       :table table :table-character char))
   	   (when (and other-char (gethash other-char mappings) (not force))
  -	     (error 'existing-directive :directive other-char :table table))
  +	     (error 'table-directive-collision
  +	       :table table :table-character other-char))
   	   (let ((directive (if function-name
   				(make-function-directive
   				 ;; #### NOTE: one could think of checking
  
positive.code: 	    (:constructor %make-format-table)
  	    (:conc-name table-))
    "Structure for format tables.
  This structure holds its name and mappings from characters to directives."
    (name nil)
    (mappings (make-hash-table) :type hash-table))
  
  (defun table-id (table)
    "Return TABLE's name or an identification string if anonymous."
    (or (table-name table)
        (with-output-to-string (str)
  	(print-unreadable-object (table str :type t :identity t)
  	  (princ "(ANONYMOUS)" str)))))
  
  (define-condition format-table-error (focus-error)
    ((table :documentation "The format table."
  	  :initarg :table
  	  :reader table))
    (:documentation "An format table error."))
  
  
  
  
negative.code: ;; Table Creation
  ;; ==========================================================================
  
  (defun make-format-table (&optional (initially :standard)
  			  &aux (table (%make-format-table))
  			       (mappings (table-mappings table)))
    "Create and return a new format table.
  The table may be INITIALLY :standard, :standard-upcase, :standard-downcase
  or :blank."
    (ecase initially
      (:standard
       (dolist (directive +standard-directives+)
         (let ((char (directive-character directive)))
  	 (setf (gethash char mappings) directive)
  	 (when (both-case-p char)
  	   (setf (gethash (char-downcase char) mappings) directive)))))
      (:standard-upcase
       (dolist (directive +standard-directives+)
         (setf (gethash (directive-character directive) mappings) directive)))
      (:standard-downcase
       (dolist (directive +standard-directives+)
         (let ((char (directive-character directive)))
  	 (when (both-case-p char)
  	   (setq char (char-downcase char)))
  	 (setf (gethash char mappings) directive))))
      (:blank))
    table)
  
  
  
  