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

(in-package :hu.dwim.projectional-editor)

;;;;;;;;
;;;; Tree domain provides:
;;;;  - node

;;;;;;
;;; Tree document classes

(def class* tree/node ()
  ((expanded :type boolean)
   (children :type sequence)))

;;;;;;
;;; Tree document constructors

(def (function e) make-tree/node (children)
  (make-instance 'tree/node :children children :expanded #t))

;;;;;;
;;; Tree reference

(def (function e) separator (previous-child next-child)
  (declare (ignore previous-child next-child))
  ;; TODO: part of reference API
  (not-yet-implemented))

(def (function e) opening-delimiter (node)
  (declare (ignore node))
  ;; TODO: part of reference API
  (not-yet-implemented))

(def (function e) closing-delimiter (node)
  (declare (ignore node))
  ;; TODO: part of reference API
  (not-yet-implemented))

;;;;;;
;;; Tree operation classes

(def class* operation/tree (operation)
  ())

(def class* operation/tree/toggle-node (operation/tree)
  ((target :type reference)))

(def class* operation/tree/replace-element-range (operation/tree)
  ((target :type reference)
   (replacement :type tree/node)))

;;;;;;
;;; Tree operation constructors

(def (function e) make-operation/tree/toggle-node (reference)
  (make-instance 'operation/tree/toggle-node :reference reference))

(def (function e) make-operation/tree/replace-element-range (reference replacement)
  (make-instance 'operation/tree/replace-element-range :reference reference :replacement replacement))

;;;;;;
;;; Tree operation API implementation

(def method redo-operation ((operation operation/tree/toggle-node) document)
  (not-yet-implemented))

(def method redo-operation ((operation operation/tree/replace-element-range) document)
  (not-yet-implemented))

;;;;;;
;;; Provider

(def (function e) tree-color-provider (iomap reference)
  (map-backward iomap reference
                (lambda (iomap reference)
                  (declare (ignore iomap))
                  (pattern-case reference
                    ((the character (elt (the string (?or (opening-delimiter ?a)
                                                          (closing-delimiter ?a))) ?b))
                     (return-from tree-color-provider
                       (sdl:color :r 196 :g 196 :b 196)))))))

(def (function e) tree-delimiter-provider (iomap reference)
  (declare (ignore iomap))
  (pattern-case reference
    ((?or (opening-delimiter ?node)
          (closing-delimiter ?node))
     (bind ((delimiter (first reference)))
       (pattern-case ?node
         ((the tree/node ?a)
          (return-from tree-delimiter-provider
            (ecase delimiter
              (opening-delimiter "(")
              (closing-delimiter ")")))))))))

(def (function e) tree-separator-provider (iomap previous-child-reference next-child-reference)
  (declare (ignore iomap previous-child-reference))
  (pattern-case next-child-reference
    ((the ?a (elt (the list (children-of (the tree/node ?b))) ?c))
     (return-from tree-separator-provider " "))))

(def (function e) tree-indentation-provider (iomap previous-child-reference next-child-reference)
  (declare (ignore iomap previous-child-reference))
  (pattern-case next-child-reference
    ((the ?a (elt (the list (children-of (the tree/node ?b))) ?c))
     (when (> ?c 0)
       (return-from tree-indentation-provider 1)))))