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

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

;;;;;;;;
;;;; Lisp form domain provides:
;;;;  - all types provided by the Common Lisp implementation

;;;;;;
;;; Lisp form document classes
;;;
;;; The lisp form document classes are provided by the Common Lisp implementation.

;;;;;;
;;; Lisp form document constructors
;;;
;;; The lisp form document constructors are provided by the Common Lisp implementation.

;;;;;;
;;; Lisp form selection classes

(def class* selection/lisp-form/printed-representation ()
  ((target :type t)
   (position :type positive-integer)))

;;;;;;
;;; Lisp form selection classes

(def (function e) make-selection/lisp-form/printed-representation (target position)
  (make-instance 'selection/lisp-form/printed-representation :target target :position position))

;;;;;;
;;; Lisp form provider

(def (function e) lisp-form-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 lisp-form-color-provider
                                       (sdl:color :r 196 :g 196 :b 196)))
                                    ((the character (elt (the string (write-to-string (the ?type (?if (subtypep ?type 'number)) ?a))) ?c))
                                     (return-from lisp-form-color-provider
                                       (sdl:color :r 0 :g 196 :b 0)))
                                    ((the character (elt (the string (string-downcase (the symbol (elt (the list ?a) ?b)))) ?c))
                                     (return-from lisp-form-color-provider
                                       (sdl:color :r 196 :g 0 :b 0)))
                                    ((the character (elt (the string (elt (the list ?a) ?b)) ?c))
                                     ;; KLUDGE: TODO: avoid matching the tree domain
                                     (unless (eq (first ?a) 'children-of)
                                       (return-from lisp-form-color-provider
                                         (sdl:color :r 196 :g 0 :b 196))))
                                    ((the character (elt (the string (write-to-string (the ?a ?b))) ?c))
                                     (return-from lisp-form-color-provider
                                       (sdl:color :r 0 :g 196 :b 196)))))))

(def (function e) lisp-form-delimiter-provider (iomap reference)
  (pattern-case reference
    ((?or (opening-delimiter ?node)
          (closing-delimiter ?node))
     (bind ((delimiter (first reference)))
       (map-backward iomap ?node
                     (lambda (iomap reference)
                       (declare (ignore iomap))
                       (pattern-case reference
                         ((the list ?a)
                          (return-from lisp-form-delimiter-provider
                            (ecase delimiter
                              (opening-delimiter "(")
                              (closing-delimiter ")")))))))))))

(def (function e) lisp-form-separator-provider (iomap previous-child-reference next-child-reference)
  (declare (ignore previous-child-reference))
  (map-backward iomap next-child-reference
                (lambda (iomap reference)
                  (declare (ignore iomap))
                  (pattern-case reference
                    ((the ?a (elt (the list ?b) ?c))
                     (return-from lisp-form-separator-provider " "))))))

(def (function e) lisp-form-indentation-provider (iomap previous-child-reference next-child-reference)
  (declare (ignore previous-child-reference))
  (map-backward iomap next-child-reference
                (lambda (iomap reference)
                  (declare (ignore iomap))
                  (pattern-case reference
                    ((the ?a (elt (the list ?b) ?c))
                     (when (> ?c 0)
                       (return-from lisp-form-indentation-provider 1)))))))