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

(in-package :hu.dwim.presentation)

;;;;;;
;;; menu-bar/widget

(def (icon e) show-submenu)

(def (component e) menu-bar/widget (standard/widget menu-items/mixin)
  ()
  (:documentation "A MENU-BAR/WIDGET is always shown with a flat list of MENU-ITEM/WIDGETs immediately VISIBLE."))

(def (macro e) menu-bar/widget ((&rest args &key &allow-other-keys) &body menu-items)
  `(make-instance 'menu-bar/widget ,@args :menu-items (flatten (list ,@menu-items))))

(def render-xhtml menu-bar/widget
  (bind (((:read-only-slots menu-items id style-class custom-style) -self-))
    (render-dojo-widget (+dijit/menu-bar+ () :id id)
      <div (:id ,-id-
            :class ,style-class
            :style ,custom-style)
        ,(foreach #'render-component menu-items)>)))

;;;;;;
;;; popup-menu/widget

(def (component e) popup-menu/widget (standard/widget content/component menu-items/mixin)
  ()
  (:documentation "A POPUP-MENU/WIDGET is only shown upon explicit user interaction on its CONTENT."))

(def (macro e) popup-menu/widget ((&rest args &key &allow-other-keys) content &body menu-items)
  `(make-instance 'popup-menu/widget ,@args :content ,content :menu-items (flatten (list ,@menu-items))))

(def render-xhtml popup-menu/widget
  (bind (((:read-only-slots menu-items id style-class custom-style) -self-))
    (when menu-items
      <span (:id ,id :class ,style-class :style ,custom-style)
        ,(render-content-for -self-)
        ,(render-dojo-widget (+dijit/menu+ `(:targetNodeIds ,id))
           <div (:id ,-id-
                 :style "display: none;")
             ,(foreach #'render-component menu-items)>)>)))

;;;;;;
;;; context-menu/widget

;; dojo context menus are broken on opera up to at least v10.10: http://bugs.dojotoolkit.org/ticket/9227

(def (icon e) show-context-menu)

(def (component e) context-menu/widget (standard/widget menu-items/mixin lazy/mixin)
  ()
  (:documentation "A CONTEXT-MENU/WIDGET is attached to its PARENT-COMPONENT as its CONTEXT-MENU."))

(def (macro e) context-menu/widget ((&rest args &key &allow-other-keys) &body menu-items)
  `(make-instance 'context-menu/widget ,@args :menu-items (flatten (list ,@menu-items))))

(def render-component context-menu/widget
  (values))

(def render-xhtml context-menu/widget
  (bind (((:read-only-slots menu-items id style-class custom-style) -self-)
         (parent-id (id-of (parent-component-of -self-))))
    (when menu-items
      (render-dojo-widget (+dijit/menu+ `(:targetNodeIds ,parent-id) :id id)
        <div (:id ,-id-
              :class ,style-class
              :style `str("display: none;" ,custom-style))
          ,(foreach #'render-component menu-items)>))))

(def layered-method render-component-stub :in xhtml-layer :after ((-self- context-menu/widget))
  (bind (((:read-only-slots id) -self-)
         (parent-id (id-of (parent-component-of -self-))))
    ;; TODO due to the custom :js this hinders the optimization in render-action-js-event-handler
    (render-action-js-event-handler "oncontextmenu" parent-id (make-action
                                                                (setf (lazily-rendered-component? -self-) #f))
                                    :js (lambda (href)
                                          `js(hdp.io.lazy-context-menu-handler event connection ,href ,id ,parent-id))
                                    :one-shot #t :stop-event #t)
    ;; another alternative, but left clicking anything will force the context menu to download, and i think :xhr-sync true is also missing...
    #+nil
    (render-action-js-event-handler "onmousedown" parent-id (make-action
                                                              (setf (to-be-rendered-component? -self-) #t))
                                    :subject-dom-node parent-id
                                    :one-shot #t :sync #t)))

;;;;;;
;;; menu-item/widget

(def (component e) menu-item/widget (standard/widget content/component menu-items/mixin)
  ()
  (:documentation "A MENU-ITEM/WIDGET is an intermediate or leaf COMPONENT in a MENU-HIERARCHY."))

(def (macro e) menu-item/widget ((&rest args &key &allow-other-keys) content &body menu-items)
  `(make-instance 'menu-item/widget ,@args :content ,content :menu-items (flatten (list ,@menu-items))))

(def (function e) make-menu-item (content &rest menu-items)
  (bind ((menu-items (flatten menu-items)))
    (when (or menu-items
              content)
      (make-instance 'menu-item/widget
                     :content content
                     :menu-items (mapcar (lambda (menu-item)
                                           (if (typep menu-item 'menu-item/widget)
                                               menu-item
                                               (make-menu-item menu-item)))
                                         menu-items)))))

(def (function e) make-submenu-item (content &rest menu-items)
  (bind ((menu-items (flatten menu-items)))
    (when menu-items
      (make-menu-item content menu-items))))

(def render-xhtml menu-item/widget
  (bind (((:read-only-slots menu-items id style-class custom-style content) -self-))
    (if menu-items
        (render-dojo-widget ((if (typep (parent-component-of -self-) 'menu-bar/widget)
                                 +dijit/popup-menu-bar-item+
                                 +dijit/popup-menu-item+))
          <div (:id ,-id-
                :class ,style-class
                :style ,custom-style)
            ,(if (stringp (content-of -self-))
                 <span ,(render-content-for -self-)>
                 (render-content-for -self-))
            ,(render-dojo-widget (+dijit/menu+)
              <div (:id ,-id-
                    :style "display: none;")
                ,(foreach #'render-component menu-items)>)>)
        (when (visible-component? content)
          (render-dojo-widget (+dijit/menu-item+ `(:iconClass ,(typecase content
                                                                 (icon/widget
                                                                  (icon-style-class content))
                                                                 (content/mixin
                                                                  (bind ((content-content (content-of content)))
                                                                    (when (typep content-content 'icon/widget)
                                                                      (icon-style-class content-content))))
                                                                 (t
                                                                  nil)))
                                 :id id)
            <div (:id ,-id-
                  :class ,style-class
                  :style ,custom-style)
                 ;; KLUDGE: kill when command/widget is refactored into mouse event support
                 ;; some parts of the RENDER-COMPONENT protocol is repeated here, because
                 ;; menu-item/widget must look ahead to support icons properly, bah
              ,(typecase content
                 (icon/widget
                  (ensure-refreshed content)
                  (render-component (force (label-of content)))
                  ;; KLUDGE: kill when command/widget is refactored into mouse event support
                  (when (typep content 'renderable/mixin)
                    (mark-rendered-component content)))
                 (content/mixin
                  (bind ((content-content (content-of content)))
                    (ensure-refreshed content)
                    ;; KLUDGE: kill when command/widget is refactored into mouse event support
                    (when (typep content 'renderable/mixin)
                      (mark-rendered-component content))
                    (if (typep content-content 'icon/widget)
                        (progn
                          (ensure-refreshed content-content)
                          (render-component (force (label-of content-content)))
                          ;; KLUDGE: kill when command/widget is refactored into mouse event support
                          (when (typep content-content 'renderable/mixin)
                            (mark-rendered-component content-content)))
                        (render-component content-content))))
                 (t
                  (render-component content)))>
            (when (typep content 'command/widget)
              (render-command-onclick-handler content id)))))))

(def function render-show-context-menu-command-for (component)
  (declare (ignore component))
  ;; TODO: add js to really show the menu
  (render-component (icon/widget show-context-menu :label nil)))

(def method command-position ((self menu-item/widget))
  (if (menu-items-of self)
      most-positive-fixnum
      (command-position (content-of self))))

;;;;;;
;;; menu-item-separator/widget

(def (component e) menu-item-separator/widget (standard/widget)
  ()
  (:documentation "A MENU-ITEM-SEPARATOR/WIDGET is a leaf COMPONENT in the MENU-HIERARCHY separating other MENU-ITEM/WIDGETs."))

(def (macro e) menu-item-separator/widget (&rest args &key &allow-other-keys)
  `(make-instance 'menu-item-separator/widget ,@args))

(def render-xhtml menu-item-separator/widget
  (bind (((:read-only-slots id) -self-))
    (render-dojo-widget (+dijit/menu-separator+ () :id id)
      <div (:id ,-id-)
        ;; NOTE: we do need the empty string in the body to workaround a bug in firefox
        ;;       that occurs when the element is rendered without an explicit closing tag
        "">)))