;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
;;; $Header: src/meta.lisp $

;;; Copyright (c) 2008, Andrea Chiumenti.  All rights reserved.

;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:

;;;   * Redistributions of source code must retain the above copyright
;;;     notice, this list of conditions and the following disclaimer.

;;;   * Redistributions in binary form must reproduce the above
;;;     copyright notice, this list of conditions and the following
;;;     disclaimer in the documentation and/or other materials
;;;     provided with the distribution.

;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(in-package :claw-html)

(defvar *components-templates* (make-hash-table)
  "Hash table that stores the templates for CLAW components")

(defclass metacomponent (standard-class)
  ()
  (:documentation "This is the meta class the must be set for every WCOMPONENT.
It creates a function whose name is the WCOMPONENT class name plus the character '>'.
The function may then be called as any other claw tag function."))

(defmethod closer-mop:validate-superclass ((class metacomponent)(super standard-class))
  t)


(defun find-first-classdefault-initarg-value (initargs initarg)
  "Returns the first class default init arg value matching matching the given INITARG"
  (loop for current-initarg in initargs
     do (when (eq (first current-initarg) initarg)
          (return (second current-initarg)))))

(defmethod initialize-instance :after ((class metacomponent) &key)
  (let* ((name (class-name class))
         (builder-function (format nil "~a>" name))
         (symbolf (find-symbol builder-function)))
    (unless symbolf
      (setf symbolf (intern builder-function)))
    (setf (fdefinition symbolf) #'(lambda(&rest rest) (build-component name rest)))))

(defun describe-html-attributes-from-class-slot-initargs (class)
  "Helper function that generates documentation for wcomponent init functions"
  (let* ((class-slots (closer-mop:class-direct-slots class)))
    (format nil "~{~%~a~}"
            (remove-if #'null
                       (reverse (loop for slot in class-slots
                                   collect (let ((slot-initarg (first (closer-mop:slot-definition-initargs slot))))
                                             (when slot-initarg
                                               (format nil
                                                       "- :~a ~a"
                                                       slot-initarg
                                                       (documentation slot 't))))))))))

(defun describe-component-behaviour (class)
  "Returns the behaviour descrioption of a WCOMPONENT init function. If it allows informal parameters, body and the reserved parameters"
  (let* ((initargs (closer-mop:class-default-initargs class))
         (reserved-parameters (find-first-classdefault-initarg-value initargs :reserved-parameters)))
    (format nil "Allows informal parameters: ~a~%Allows body: ~a~%Reserved parameters: ~a~%"
            (if (find-first-classdefault-initarg-value initargs :allow-informal-parameters)
                "Yes"
                "No")
            (if (find-first-classdefault-initarg-value initargs :empty)
                "No"
                "Yes")
            (if reserved-parameters
                (format nil "~{:~a ~}" (eval reserved-parameters))
                "NONE"))))