                           given 0 new-name)))))
           new-name)))))
 
-
-
-(defn make-editable-context2
-  "Takes an optional context as input and returns the appropriate
-   editable context structure.
-
-  Parameters:
-    context-in     _context or editable context"
-  ([context-in]
-    (let [ self (promise)
-           ctx (get-context context-in)
-           obj (objects ctx)
-           attr (attributes ctx)
-           inc (incidence ctx)
-           obj-map (map-to-unique-strings obj)
-           attr-map (map-to-unique-strings attr)
-           compatible-obj (map obj-map obj)
-           compatible-attr (map attr-map attr)
-           compatible-inc  (map (fn [x] [(obj-map (first x)) 
-                                          (attr-map (second x))]) inc)
-           compatible-ctx (make-context compatible-obj
-                            compatible-attr compatible-inc)
-           attr-range (range 1 (+ 1 (count compatible-attr)))
-           obj-range (range 1 (+ 1 (count compatible-obj)))
-
-
-           assoc-widgets   (ref #{})
-           context         (ref compatible-ctx)
-           attr-cols       (ref (conj (zipmap compatible-attr attr-range)
-                                  (zipmap attr-range compatible-attr)))
-           obj-rows        (ref (conj (zipmap compatible-obj obj-range)
-                                  (zipmap obj-range compatible-obj)))
-
-
-           extend-rows-hook
-           (fn-doc "This hook is called when the number of rows is extended by
-  pasting content that is too big for the table.
-
-  Parameters:
-    widget   _the widget object where the paste operation takes place
-    old-rows _the number of rows that were present in the table before
-    new-rows _the number of rows that will be needed for the paste"
-             [table old-rows new-rows]
-             (let [ other-widgets (filter
-                                    (fn [w] (not= (w :table) table))
-                                    @assoc-widgets)]
-               (do
-                 (doseq [w other-widgets] (!!!! (w :table) 
-                                            :extend-rows-to new-rows))
-                 (doseq [x (range old-rows new-rows)] (!! table 
-                                                        :set-value-at-index x 0 
-                                                        "new object")))))
-
-           extend-columns-hook
-           (fn-doc "This hook is called when the number of columns is extended
-  by pasting content that is too big for the table.
-
-  Parameters:
-    widget      _the widget object where the paste operation takes place
-    old-columns _the number of rows that were present in the table before
-    new-columns _the number of rows that will be needed for the paste"
-             [table old-columns new-columns]
-             (let [ other-widgets (filter
-                                    (fn [w] (not= (w :table) table))
-                                    @assoc-widgets)]
-               (do
-                 (doseq [w other-widgets]
-                   (!!!! (w :table) :extend-columns-to new-columns))
-                 (doseq [x (range old-columns new-columns)]
-                   (!! table :set-value-at-index 0 x "new attribute")))))
-
-           update-incidence
-           (fn-doc "This function updates the incidence relation.
-
-  Parameters:
-    object     _the object
-    attribute  _the attribute
-    cross      _true, if object has attribute, false otherwise"
-             [object attribute cross]
-             (dosync-wait (commute context 
-                            (fn [x]
-                              (let [ objs (objects x)
-                                     attrs (attributes x)
-                                     inc (incidence x) 
-                                     op (if cross conj disj)]
-                                (make-context objs attrs 
-                                  (op inc [object attribute])))))))
-
-
-           change-object-name
-           (fn-doc "This function will change the name of the object in
-  the specified row to the new given name, if the new name does not conflict,
-  or otherwise to a conflict free new name; and returns the new name of the
-  object.
-
-  Parameters:
-    model-row      _row of the object in the model
-    req-name       _requested new object name"
-             [model-row req-name]
-             (dosync-wait
-               (let [ objs (objects (get-context @context))
-                      current-name (@obj-rows model-row)
-                      other-objs (disj objs current-name)
-                      new-name (req-unique-string other-objs
-                                 req-name) ]
-                 (do
-                   (if (not= current-name new-name)
-                     (let [ omap (fn [x] (if (= x current-name) new-name x))]
-                       (dosync
-                         (commute context
-                           (fn [x] (let [os (conj (disj (objects x) 
-                                                    current-name)
-                                              new-name)
-                                         as (attributes x)
-                                         inc (map 
-                                               (fn [x] [ (omap (first x))
-                                                         (second x)])
-                                               (incidence x))]
-                                     (make-context os as inc))))
-                         (commute obj-rows switch-bipartit-auto 
-                           model-row current-name
-                           model-row new-name))))                         
-                   new-name))))
-             
-           set-cell-value-hook
-           (fn-doc "This hook is called when a cell's value in the table widget
-  has been changed, the passed contents have to be translated into allowed con-
-  tents that will eventually be set in the widget.
-
-  Parameters:
-    widget     _the widget object
-    row        _integer identifying a row 
-    column     _integer identifying a column 
-    contents   _the desired new contents
-
-  Returns the new allowed contents for the cell (as string)."
-             [table row column contents]
-             (let [ model-column column
-                    model-row row
-                    good-value
-                    (cond (= model-column model-row 0) "⇊objects⇊"
-                      (= model-row 0) 
-                      (let [attrib-cols @attr-cols
-                            current-name (attrib-cols model-column)] 
-                        (if (= contents current-name) current-name
-                          (change-attribute-name model-column contents)))
-                      (= model-column 0)
-                      (let [object-rows @obj-rows
-                             current-name (object-rows model-row)]
-                        (if (= contents current-name) current-name
-                          (change-object-name model-row contents)))
-                      true ;else
-                      (let [ cross (string-to-cross contents)
-                             obj-name (@obj-rows model-row)
-                             attr-name (@attr-cols model-column)
-                             fca-ctx (get-context @context)
-                             inc (incidence fca-ctx)
-                             current-state (contains? inc [obj-name attr-name])]
-                        (do
-                          (if (not= current-state cross)
-                            (update-incidence obj-name attr-name cross))
-                          (if cross "X" " ")))
-                      )
-                    other-widgets (filter
-                                    (fn [w] (not= (w :table) table))
-                                    @assoc-widgets)]
-               (do
-                 (doseq [w other-widgets]
-                   (!! (w :table) :update-value-at-index 
-                             row column good-value))
-                 good-value)))
-            
-
-           set-table-extents
-           (fn-doc "This function will set the row and column count of the
-  table widget to the appropriate sizes.
-
-  Parameters:
-    table  _table widget"
-             [table]
-             (dosync
-               (let [ ctx @context 
-                      fca-ctx (get-context ctx)
-                      attrs (attributes fca-ctx)
-                      attr-count (count attrs)
-                      objs (objects fca-ctx)
-                      obj-count (count objs)]
-                 (do
-                   (!! table :set-column-count (+ 1 attr-count))
-                   (!! table :set-row-count (+ 1 obj-count))))))
-                      
-           
-           fill-table-widget
-           (fn-doc "This function will fill the given table widget with the
-  contents of the editable context.
-
-  Parameters:
-    table   _table widget"
-             [table]
-             (dosync
-               (let [ ctx @context 
-                      fca-ctx (get-context ctx)
-                      attrs (attributes fca-ctx)
-                      inc (incidence fca-ctx)
-                      get-cross (fn [obj att] (if (contains? inc [obj att])
-                                                "X" " "))
-                      attr-count (count attrs)
-                      objs (objects fca-ctx)
-                      obj-count (count objs)
-                      attrib-cols @attr-cols
-                      object-rows @obj-rows]
-                 (do
-                   (!! table :set-column-count (+ 1 attr-count))
-                   (!! table :set-row-count (+ 1 obj-count))
-                   (!! table :set-value-at-index 0 0 "")
-                   (doseq [x attrs]
-                     (let [column (attrib-cols x)]
-                               (!! table :set-value-at-index 0 column x)))
-                   (doseq [x objs]
-                     (let [row (object-rows x)]
-                               (!! table :set-value-at-index row 0 x)))
-                   (doseq [a attrs]
-                    (doseq [o objs]
-                                 (let [ row (object-rows o)
-                                        column (attrib-cols a)]
-                                   (!! table :set-value-at-index row column 
-                                     (get-cross o a)))))))))
-
-           
-
-           editable-ctx 
-           {:editable-context 1
-           :context context
-           :associated-widgets assoc-widgets
-           :attribute-columns attr-cols
-           :object-rows obj-rows
-
-           :get
-           (fn-doc "Returns the fca-context that is associated with the
-  current state of the editable context."
-             [] (get-context @context))
-
-           :set
-           (fn-doc "Sets the current state of the editable context to the
-  given fca context.
-
-  Parameters:
-    context-in  _(fca) context"
-             [context-in]
-             (let [ ctx (get-context context-in)
-                    obj (objects ctx)
-                    attr (attributes ctx)
-                    inc (incidence ctx)
-                    obj-map (map-to-unique-strings obj)
-                    attr-map (map-to-unique-strings attr)
-                    compatible-obj (map obj-map obj)
-                    compatible-attr (map attr-map attr)
-                    compatible-inc  (map (fn [x] [(obj-map (first x)) 
-                                                   (attr-map (second x))])
-                                      inc)
-                    compatible-ctx (make-context compatible-obj
-                                     compatible-attr compatible-inc) 
-                    attr-range (range 1 (+ 1 (count compatible-attr)))
-                    obj-range (range 1 (+ 1 (count compatible-obj)))
-
-
-                    
-                    new-attr-cols  (conj (zipmap compatible-attr attr-range)
-                                     (zipmap attr-range compatible-attr))
-                    new-obj-rows   (conj (zipmap compatible-obj obj-range)
-                                     (zipmap obj-range compatible-obj)) ]
-               (do
-                 (dosync-wait 
-                   (ref-set context compatible-ctx)
-                   (ref-set attr-cols new-attr-cols)
-                   (ref-set obj-rows new-obj-rows))
-                 (!! @self :update-))))
-
-           :update-
-           (fn-doc "Updates all widgets that are associated with the editable
-  context by forcing a complete table refresh from data."
-             []
-             (let [ widgets @assoc-widgets
-                    tables  (map :table widgets)]
-               (dosync
-                 (doseq [t tables] (set-table-extents t))
-                 (doseq [t tables] (fill-table-widget t)))))
-
-           :remove-widget-
-           (fn-doc "Removes a widget from associated widgets.
-  Parameters:
-    widget     _widget to be removed"
-             [widget]
-             (do
-               (dosync-wait (commute assoc-widgets disj widget))
-               (let [ table (widget :table)
-                      empty-ext-hook (fn-doc "Empty extend hook" 
-                                       [widget old-rows new-rows] nil)
-                      empty-val-hook (fn-doc "Empty set cell value hook"
-                        [widget row column contents]
-                        contents)]
-                 (do
-                   (!! table :set-handler-and-wait 
-                     :set-cell-value-hook empty-val-hook)
-                   (!! table :set-handler-and-wait 
-                     :extend-columns-hook empty-ext-hook)
-                   (!! table :set-handler-and-wait 
-                     :extend-rows-hook empty-ext-hook)))))
-
-           :add-widget-
-           (fn-doc "Adds a widget to associated widgets and updates the control
-  accordingly.
-
-  Parameters:
-    widget    _context-widget to be added"
-             [widget]
-             (do
-               (dosync-wait (commute assoc-widgets conj widget))
-               (let [ table (widget :table)]
-                 (do
-                   (!! table :set-handler-and-wait 
-                     :set-cell-value-hook set-cell-value-hook)
-                   (!! table :set-handler-and-wait 
-                     :extend-columns-hook extend-columns-hook)
-                   (!! table :set-handler-and-wait 
-                     :extend-rows-hook extend-rows-hook)
-                   (fill-table-widget table)))))
-          }]
-               (do
-                 (deliver self editable-ctx)
-                 editable-ctx)))
- ([]
-   (make-editable-context (make-context [] [] []))))
-
 (def ctx (conexp.fca/make-context ["a" "b" "c"] [1 2 3] [["a" 1] ["c" 3]]))
 (def ctx2 (make-context #{"Apfel" "Birne" "Möhre" "Gurke"} 
             #{"lecker" "geht so" "iieh"} 

(defmethod get-table :conexp.gui.editors.util/table-control
  [x] x)


(defn-swing do-mk-context-editor-widget
  "Creates a control for editing contexts.

  Parameters:
     & setup     _an optional number of vectors that may contain additional
                  tweaks that are called after widget creation"
  [& setup]
  (let [ self (promise)
         root (JRootPane.)
         table (make-table-control
                 [set-row-count 10]
                 [set-column-count 10])

         toolbar (make-toolbar-control :vert
                   [add-button 
                     (make-button "Copy" 
                       (get-ui-icon "OptionPane.informationIcon")
                       [set-handler (fn [] (copy-to-clipboard table))] )]
                   [add-button
                     (make-button "Paste" 
                       (get-ui-icon "OptionPane.informationIcon")
                       [set-handler (fn [] (paste-from-clipboard table))] ) ])

                   
         widget {:managed-by-conexp-gui-editors-util "context-editor-widget"

         :widget root
         :table table
         :control (get-control table)
         :context (ref nil)

         :associate-context
         (fn-doc "Associates a context with the widget object and implicitly
  updates the control

  Parameters:
    ectx      _editable context"
           [ectx]
           (let [ ctx (if (editable-context? ectx) ectx 
                       (make-editable-context ectx))
                  ctx-ref (@self :context)
                  old-ctx @ctx-ref]
             (do
               (dosync-wait (ref-set ctx-ref nil))
               (if (not (nil? old-ctx)) (!! old-ctx :remove-widget- @self))
               (!! ctx :add-widget- @self))
               (dosync-wait (ref-set ctx-ref ctx))))


         }

         defaults []]
    (do
      (deliver self widget)
      (.. root getContentPane 
        (add (get-widget toolbar) BorderLayout/LINE_START))
      (.. root getContentPane
        (add (get-widget table)))
      (doseq [x defaults] (unroll-parameters-fn-map widget x))
      (doseq [x setup] (unroll-parameters-fn-map widget x))
      widget )))

(declare change-attribute-name change-object-name change-incidence-cross)


    (set-hook table "cell-value" 
      (fn [r c s] (ectx-cell-value-hook e-ctx r c s)))))

(inherit-multimethod set-context ::editable-context
  "Sets the bound fca-context of an editable context object to ctx.

   Parameters:
    ectx   _editable-context object
    ctx    _new context")

(defmethod
  set-context ::editable-context
  [ectx ctx]
  (let [ new (make-editable-context ctx)
         widgets @(:widgets ectx) ]
    (dosync-wait
      (ref-set (:widgets ectx) @(:widgets new))
      (ref-set (:context ectx) @(:context new))
      (ref-set (:attr-cols ectx) @(:attr-cols new))
      (ref-set (:obj-rows ectx) @(:obj-rows new)))
    (call-many widgets (rho add-widget ectx))))


                   
(declare change-attribute-name change-object-name change-incidence-cross)

