;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; Copyright (c) 2009 by the authors.
;;;
;;; See LICENCE for details.

(in-package :hu.dwim.presentation)

;;;;;;
;;; sequence/inspector

(def (component e) sequence/inspector (t/inspector)
  ())

(def method component-dispatch-class ((component sequence/inspector))
  ;; TODO: KLUDGE: this should be an argument
  (awhen (component-value-of component)
    (class-of (first-elt it))))

;;;;;;
;;; sequence/alternator/inspector

(def (component e) sequence/alternator/inspector (t/alternator/inspector sequence/inspector)
  ())

(def subtype-mapper *inspector-type-mapping* sequence sequence/alternator/inspector)

(def layered-method make-alternatives ((component sequence/alternator/inspector) class prototype value)
  (bind (((:read-only-slots editable-component edited-component component-value-type) component))
    ;; FIXME error: VALUE here can be ("_j" . "t") on which find-if dies. reproduce: inspect request, expand the query parameters.
    (optional-list (awhen (find-if [not (null (class-slots (class-of !1)))] value)
                     (make-instance 'sequence/table/inspector
                                    :component-value value
                                    :component-value-type component-value-type
                                    :edited edited-component
                                    :editable editable-component
                                    :deep-arguments (alternative-deep-arguments component 'sequence/table/inspector)))
                   (make-instance 'sequence/list/inspector
                                  :component-value value
                                  :component-value-type component-value-type
                                  :edited edited-component
                                  :editable editable-component)
                   (make-instance 'sequence/tree/inspector
                                  :component-value value
                                  :component-value-type component-value-type
                                  :edited edited-component
                                  :editable editable-component)
                   (make-instance 'sequence/treeble/inspector
                                  :component-value value
                                  :component-value-type component-value-type
                                  :edited edited-component
                                  :editable editable-component)
                   (make-instance 'sequence/reference/inspector
                                  :component-value value
                                  :component-value-type component-value-type
                                  :edited edited-component
                                  :editable editable-component))))

;;;;;;
;;; sequence/reference/inspector

(def (component e) sequence/reference/inspector (t/reference/inspector sequence/inspector)
  ())

;;;;;;
;;; sequence/list/inspector

(def (component e) sequence/list/inspector (t/detail/inspector sequence/inspector list/widget)
  ())

(def refresh-component sequence/list/inspector
  (bind (((:slots component-value contents) -self-)
         (class (component-dispatch-class -self-))
         (prototype (component-dispatch-prototype -self-)))
    (setf contents (iter (for element-value :in-sequence component-value)
                         (for element = (find element-value contents :key #'component-value-of :test #'component-value=))
                         (if element
                             (setf (component-value-of element) element-value)
                             (setf element (make-element-presentation -self- class prototype element-value)))
                         (collect element)))))

(def layered-method make-page-navigation-bar ((component sequence/list/inspector) class prototype value)
  (make-instance 'page-navigation-bar/widget :total-count (length value)))

(def (layered-function e) make-element-presentation (component class prototype value)
  (:method ((component sequence/list/inspector) class prototype value)
    (make-instance 't/element/inspector
                   :component-value value
                   :edited (edited-component? component)
                   :editable (editable-component? component))))

;;;;;;
;;; t/element/inspector

(def (component e) t/element/inspector (t/detail/inspector element/widget)
  ())

(def refresh-component t/element/inspector
  (bind (((:slots component-value content) -self-)
         (class (component-dispatch-class -self-))
         (prototype (component-dispatch-prototype -self-)))
    (if content
        (setf (component-value-of content) component-value)
        (setf content (make-content-presentation -self- class prototype component-value)))))

(def layered-method make-content-presentation ((component t/element/inspector) class prototype value)
  (make-value-inspector value
                        :initial-alternative-type 't/reference/inspector
                        :edited (edited-component? component)
                        :editable (editable-component? component)))

;;;;;;
;;; sequence/columns/component

(def (component e) sequence/columns/component (sequence/inspector)
  ())

(def (layered-function e) make-column-presentations (component class prototype value)
  (:method ((component sequence/columns/component) class prototype value)
    (append (optional-list (when-bind the-class (component-dispatch-class component)
                             (when (class-direct-subclasses the-class)
                               (make-type-column-presentation component class prototype value))))
            (make-place-column-presentations component class prototype value))))

(def (layered-function e) make-type-column-presentation (component class prototype value)
  (:method ((component sequence/columns/component) class prototype value)
    (make-instance 'place/column/inspector
                   :component-value "BLAH" ;; TODO:
                   :header #"object-list-table.column.type"
                   :cell-factory (lambda (component)
                                   (bind ((class (class-of (component-value-of component))))
                                     (make-value-viewer class :initial-alternative-type 't/reference/inspector))))))

;; TODO: split for sequence/table/inspector and sequence/treeble/inspector, the latter must recurse down
(def (layered-function e) make-place-column-presentations (component class prototype value)
  (:method ((component sequence/columns/component) class prototype value)
    (bind ((slot-name->slot-map nil)
           (slots (append (collect-class-specific-presented-slots component class prototype value)
                          (collect-instance-specific-presented-slots component class prototype value))))
      (dolist (slot slots)
        (bind ((slot-name (slot-definition-name slot)))
          (unless (member slot-name slot-name->slot-map :test #'eq :key #'car)
            (push (cons slot-name slot) slot-name->slot-map))))
      (mapcar (lambda (slot-name+slot)
                (make-instance 'place/column/inspector
                               :component-value "BLAH" ;; TODO:
                               :header (localized-slot-name (cdr slot-name+slot))
                               :cell-factory (lambda (component)
                                               (bind ((slot (find-slot (class-of (component-value-of component)) (car slot-name+slot) :otherwise nil)))
                                                 (if slot
                                                     (make-instance 'place/cell/inspector
                                                                    :component-value (make-object-slot-place (component-value-of component) slot))
                                                     (empty/layout))))))
              (nreverse slot-name->slot-map)))))

(def (layered-function e) collect-class-specific-presented-slots (component class prototype value)
  (:method ((component sequence/columns/component) class prototype value)
    (when class
      (collect-presented-slots component class (class-prototype class) value))))

(def layered-method collect-presented-slots ((component sequence/columns/component) class prototype value)
  (class-slots class))

(def layered-method collect-presented-places ((component sequence/columns/component) class prototype value)
  (mapcar [make-object-slot-place value !1] (collect-presented-slots component class prototype value)))

;;;;;;
;;; sequence/table/inspector

(def (component e) sequence/table/inspector (t/detail/inspector
                                             sequence/columns/component
                                             table/widget
                                             component-messages/widget
                                             deep-arguments/mixin)
  ())

(def refresh-component sequence/table/inspector
  (bind (((:slots component-value rows columns) -self-)
         (class (component-dispatch-class -self-))
         (prototype (component-dispatch-prototype -self-)))
    (setf rows (iter (for row-value :in-sequence component-value)
                     (for row = (find row-value rows :key #'component-value-of :test #'component-value=))
                     (if row
                         (setf (component-value-of row) row-value)
                         (setf row (make-row-presentation -self- class prototype row-value)))
                     (collect row)))
    (setf columns (make-column-presentations -self- class prototype component-value))))

(def layered-method make-page-navigation-bar ((component sequence/table/inspector) class prototype value)
  (apply #'make-instance 'page-navigation-bar/widget
         :total-count (length value)
         (component-deep-arguments component :page-navigation-bar)))

(def (layered-function e) make-row-presentation (component class prototype value)
  (:method ((component sequence/table/inspector) class prototype value)
    (make-instance 't/row/inspector
                   :component-value value
                   :edited (edited-component? component)
                   :editable (editable-component? component))))

;; TODO: find a proper superclass name
(def (layered-function e) collect-instance-specific-presented-slots (component class prototype value)
  (:method ((component sequence/table/inspector) class prototype value)
    (iter (for row :in-sequence (rows-of component))
          (appending (collect-presented-slots row (component-dispatch-class row) (component-dispatch-prototype row) (component-value-of row))))))

;;;;;;
;;; place/column/inspector

(def (component e) place/column/inspector (t/detail/inspector column/widget)
  ((cell-factory :type (or symbol function))))

;; KLUDGE: t/detail/inspector overrides component-style-class of column/widget, undo that
(def method component-style-class ((self place/column/inspector))
  (string+ "table-header-border " (call-next-method)))

;;;;;;
;;; t/row/inspector

(def (component e) t/row/inspector (t/detail/inspector
                                    row/widget
                                    component-messages/widget)
  ())

(def refresh-component t/row/inspector
  (bind (((:slots component-value command-bar cells) -self-))
    (setf cells
          (if component-value
              (mapcar (lambda (column)
                        (funcall (cell-factory-of column) -self-))
                      (columns-of *table*))
              nil))))

(def layered-method render-table-row :before ((table sequence/table/inspector) (row t/row/inspector))
  (when (messages-of row)
    (render-table-row table (make-instance 'entire-row/widget :content (inline-render/widget ()
                                                                         (render-component-messages-for row))))))

(def layered-method render-onclick-handler ((row t/row/inspector) button)
  (if-bind expand-command (find-command row 'expand-component)
    (render-command-onclick-handler expand-command (id-of row))
    (call-next-layered-method)))

(def layered-method make-context-menu-items ((component t/row/inspector) class prototype value)
  (append (optional-list (make-menu-item (make-expand-command component class prototype value))) (call-next-layered-method)))

(def layered-method make-command-bar-commands ((component t/row/inspector) class prototype value)
  nil)

(def layered-method make-move-commands ((component t/row/inspector) class prototype value)
  nil)

(def layered-method make-expand-command ((component t/row/inspector) class prototype value)
  (bind ((replacement-component nil))
    (make-replace-and-push-back-command component
                                        (delay (setf replacement-component
                                                     (make-instance 't/entire-row/inspector
                                                                    :component-value value
                                                                    :edited (edited-component? component)
                                                                    :editable (editable-component? component))))
                                        (list :content (icon/widget expand-component)
                                              :visible (delay (not (has-edited-descendant-component? component)))
                                              :subject-component component)
                                        (list :content (icon/widget collapse-component)
                                              :subject-component (delay replacement-component)))))

(def layered-method collect-presented-slots ((component t/row/inspector) class prototype value)
  (class-slots class))

;;;;;;
;;; t/entire-row/inspector

(def (component e) t/entire-row/inspector (t/detail/inspector
                                           entire-row/widget
                                           component-messages/widget)
  ())

(def refresh-component t/entire-row/inspector
  (bind (((:slots component-value content) -self-))
    (setf content
          (if component-value
              (make-value-inspector component-value
                                    :edited (edited-component? -self-)
                                    :editable (editable-component? -self-))
              (empty/layout)))))

;;;;;;
;;; place/cell/inspector

(def (component e) place/cell/inspector (t/detail/inspector cell/widget)
  ())

(def refresh-component place/cell/inspector
    (bind (((:slots component-value content) -self-))
      (setf content (if component-value
                        (make-instance 'place/value/inspector
                                       :component-value component-value
                                       :edited (edited-component? -self-)
                                       :editable (editable-component? -self-))
                        (empty/layout)))))