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

(in-package :hu.dwim.presentation)

;;;;;;
;;; API

(def (generic e) application-relative-path-for-no-javascript-support-error (application)
  (:method ((application application))
    "/help/"))

;;;;;;
;;; frame/widget

(def (component e) frame/widget (top/component layer/mixin)
  ((content-mime-type +xhtml-mime-type+)
   (stylesheet-uris nil)
   (script-uris (make-default-script-uris))
   (page-icon-uri (make-page-icon-uri :hu.dwim.presentation "static/hdp/" "image/miscellaneous/favicon.ico"))
   (title nil)
   (debug-client-side :type boolean :writer (setf debug-client-side?))))

(def method parent-component-of ((self frame/widget))
  nil)

(def method supports-debug-component-hierarchy? ((self frame/widget))
  #f)

;;;;;;
;;; dojo-frame/widget

(def (component e) dojo-frame/widget (frame/widget)
  ((dojo-skin-name *dojo-skin-name*)
   (dojo-release-uri (hu.dwim.uri:parse-uri (string+ "static/hdws/libraries/" *dojo-directory-name* "dojo/")))
   (dojo-file-name *dojo-file-name*)
   (parse-dojo-widgets-on-load #f :type boolean)))

;;; sencha-frame/widget
(def (component e) sencha-frame/widget (frame/widget)
  ((sencha-touch-skin-name *sencha-touch-skin-name*)
   (sencha-touch-release-uri (hu.dwim.uri:parse-uri (string+ "static/hdws/libraries/" *sencha-touch-directory-name*)))
   (sencha-touch-file-name *sencha-touch-file-name*)))

;;; extjs-frame/widget
(def (component e) extjs-frame/widget (frame/widget)
  ((extjs-skin-name *extjs-skin-name*)
   (extjs-release-uri (hu.dwim.uri:parse-uri (string+ "static/hdws/libraries/" *extjs-directory-name*)))
   (extjs-file-name *extjs-file-name*)))

(def (macro e) frame/widget ((&rest args &key (widget-library :dojo) &allow-other-keys) &body content)
  (remove-from-plistf args :widget-library)
  (ecase widget-library
    (:dojo `(make-instance 'dojo-frame/widget ,@args :content ,(the-only-element content)))
    (:extjs `(make-instance 'extjs-frame/widget ,@args :content ,(the-only-element content)))
    (:sencha `(make-instance 'sencha-frame/widget ,@args :content ,(the-only-element content)))))

(def method debug-client-side? ((self frame/widget))
  (if (slot-boundp self 'debug-client-side)
      (slot-value self 'debug-client-side)
      (debug-client-side? *application*)))

;; define a component-environment for each widget library
(macrolet ((defcompenv (&body entries)
             `(progn
                ,@(loop for name in entries
                        collect `(def component-environment ,(symbolicate name '-frame/widget)
                                     (with-active-layers (,(symbolicate name '-layer))
                                       (call-next-method)))))))
  (defcompenv dojo extjs sencha))

(def (function e) make-page-icon-uri (asdf-system-name-or-base-directory path-prefix path)
  (bind ((base-directory (aif (find-system asdf-system-name-or-base-directory #f)
                              (system-relative-pathname it "www/")
                              asdf-system-name-or-base-directory))
         (file (assert-file-exists (merge-pathnames path base-directory))))
    (list (hu.dwim.uri:parse-uri (string+ path-prefix path))
          (delay (file-write-date file)))))

;; FIXME darabi: add argument dojo ...
(def (function e) make-default-script-uris ()
  (load-time-value
   (list (list (hu.dwim.uri:parse-uri "/hdws/js/main.dojo.js")
               (bind ((file (system-relative-pathname :hu.dwim.web-server "source/js/main.dojo.lisp")))
                 (delay (file-write-date file))))
         (list (hu.dwim.uri:parse-uri "/hdp/js/main.dojo.js")
               (bind ((file (system-relative-pathname :hu.dwim.presentation "source/js/main.dojo.lisp")))
                 (delay (file-write-date file))))
         (list (hu.dwim.uri:parse-uri +js-i18n-broker/default-path+)
               (delay hu.dwim.web-server::*js-i18n-resource-registry/last-modified-at*))
         (list (hu.dwim.uri:parse-uri +js-component-hierarchy-serving-broker/default-path+)
               (delay *js-component-hierarchy-cache/last-modified-at*)))))

(def function %make-stylesheet-uris (asdf-system-name-or-base-directory path-prefix &rest relative-paths)
  (bind ((base-directory (aif (find-system asdf-system-name-or-base-directory #f)
                              (system-relative-pathname it "www/")
                              asdf-system-name-or-base-directory)))
    (iter (for path :in relative-paths)
          (collect (list (hu.dwim.uri:parse-uri (string+ path-prefix path))
                         (bind ((file (assert-file-exists (merge-pathnames path base-directory))))
                           (delay (file-write-date file))))))))

(def (function e) make-default-stylesheet-uris ()
  (flet ((dojo-relative-path (path)
           (hu.dwim.uri:parse-uri (string+ "static/hdws/libraries/" *dojo-directory-name* path))))
    (append
     (mapcar #'dojo-relative-path
             '("dojo/resources/dojo.css"
               "dijit/themes/tundra/tundra.css"))
     (%make-stylesheet-uris :hu.dwim.presentation "static/hdp/"
                            "css/wui.css"
                            "css/icon.css"
                            "css/border.css"
                            "css/layout.css"
                            "css/widget.css"
                            "css/text.css"
                            "css/lisp-form.css"
                            "css/shell-script.css"
                            "css/presentation.css"))))


(def (function e) make-stylesheet-uris (asdf-system-name-or-base-directory path-prefix &rest relative-paths)
  (append (make-default-stylesheet-uris)
          (apply #'%make-stylesheet-uris asdf-system-name-or-base-directory path-prefix relative-paths)))