(in-package :clog-tools)

;; Handle per content next-id counts

(defun next-id (content)
  "Get next id for CONTENT"
  (parse-integer (attribute content "data-clog-next-id") :junk-allowed t))

(defun setf-next-id (content id)
  "Store ID on CONTENT"
  (setf (attribute content "data-clog-next-id") (format nil "~A" id)))

(defun incf-next-id (content)
  "Increment next id and store it in CONTENT"
  (setf-next-id content (1+ (next-id content))))

;; Snap-shots

(defun panel-snap-shot (content panel-id hide-loc)
  "Take a snap shot of panel"
  (with-sync-event (content)
    (let (snap
          (app (connection-data-item content "builder-app-data")))
      (maphash
        (lambda (html-id control)
          (declare (ignore html-id))
          (place-inside-bottom-of hide-loc
                                  (get-placer control)))
        (get-control-list app panel-id))
      (let ((data
              (create-child content "<data />"
                            :auto-place :top
                            :html-id (format nil "I~A" (get-universal-time)))))
        (setf (attribute data "data-in-package")
              (attribute content "data-in-package"))
        (setf (attribute data "data-custom-slots")
              (attribute content "data-custom-slots"))
        (setf (attribute data "data-clog-next-id")
              (attribute content "data-clog-next-id"))
        (setf (attribute data "data-clog-title")
              (attribute content "data-clog-name"))
        (setf snap (js-query content
                             (format nil
                                     "var z=~a.clone();~
                 z.find('*').each(function(){~
                   if($(this).attr('data-clog-composite-control') == 't'){$(this).text('')}~
                   if($(this).attr('id') !== undefined && ~
                     $(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~
                 z.html();"
                                     (jquery content))))
        (let ((pp (js-query content
                            (format nil "html_beautify ('~A',{'wrap_line_length':'80',~
                                        'extra_liners':'div,form,input,button,select,textarea,ol,ul,table,style,datalist'})"
                            (escape-string snap)))))
          (if (and pp
               (not (equal pp "")))
              (setf snap pp)
              (format t "html_beautify failure")))
        (destroy data))
      (maphash
        (lambda (html-id control)
          (declare (ignore html-id))
          (place-after control (get-placer control)))
        (get-control-list app panel-id))
      snap)))

(defun save-panel (fname content panel-id hide-loc)
  "Save panel to FNAME"
  (write-file (panel-snap-shot content panel-id hide-loc) fname :clog-obj content))

;; Add controls to panels

(defun create-control (parent content control-record uid &key custom-query)
  "Return a new control based on CONTROL-RECORD as a child of PARENT"
  (let* ((create-type       (getf control-record :create-type))
         (control-type-name (getf control-record :name))
         (control           (cond ((eq create-type :base)
                                    (funcall (getf control-record :create) parent
                                             :html-id uid))
                                  ((eq create-type :custom)
                                    (funcall (getf control-record :create) parent
                                             (getf control-record :create-content)
                                             :html-id uid))
                                  ((eq create-type :custom-block)
                                    (let ((c (funcall (getf control-record :create) parent
                                                      :content custom-query
                                                      :html-id uid)))
                                      (setf (attribute c "data-original-html") custom-query)
                                      c))
                                  ((eq create-type :custom-query)
                                    (funcall (getf control-record :create) parent
                                             custom-query
                                             :html-id uid))
                                  ((eq create-type :custom-panel)
                                    (let* ((c (funcall (eval (read-from-string (format nil "'~A" custom-query)))
                                                      parent
                                                      :html-id uid)))
                                      (setf control-type-name "div")
                                      c))
                                  ((eq create-type :custom-control)
                                    (let* ((c (funcall (eval (read-from-string (format nil "'~A" custom-query)))
                                                      parent
                                                      :html-id uid)))
                                      (setf (attribute c "data-clog-composite-control") "t")
                                      (setf (attribute c "data-clog-custom-create") custom-query)
                                      c))
                                   ((eq create-type :paste)
                                    (let ((c (create-child parent custom-query
                                                           :html-id uid)))
                                      (setf control-type-name (attribute c "data-clog-type"))
                                      (when (equalp control-type-name "undefined")
                                        (setf (attribute c "data-clog-type") "div")
                                        (setf control-type-name "div"))
                                      (let ((cr (control-info control-type-name)))
                                        (change-class c (getf cr :clog-type)))
                                      c))
                                  ((eq create-type :element)
                                    (funcall (getf control-record :create) parent
                                             :html-id uid
                                             :content (if (equal (getf control-record :create-content) "")
                                                          ""
                                                          (format nil "~A-~A"
                                                                  (getf control-record :create-content)
                                                                  (next-id content)))))
                                  ((eq create-type :form)
                                    (funcall (getf control-record :create) parent
                                             (getf control-record :create-param)
                                             :html-id uid
                                             :value (if (equal (getf control-record :create-value) "")
                                                        ""
                                                        (format nil "~A-~A"
                                                                (getf control-record :create-value)
                                                                (next-id content)))))
                                  ((eq create-type :textarea)
                                    (funcall (getf control-record :create) parent
                                             :html-id uid
                                             :value (getf control-record :create-value)))
                                  (t nil))))
    (when control
      (setf (attribute control "data-clog-type") control-type-name)
      (when (getf control-record :setup)
        (funcall (getf control-record :setup) control content control-record)))
    control))

(defun drop-new-control (app content data &key win)
  "Create new control dropped at event DATA location on CONTENT of WIN"
  ;; any click on panel directly will focus window
  (when win
    (window-focus win))
  (when (select-tool app)
    (let* ((control-record    (control-info (value (select-tool app))))
           (control-type-name (getf control-record :create-type)))
      (cond ((eq control-type-name :custom-query)
              (input-dialog win "Enter html (must have one outer element):"
                            (lambda (custom-query)
                              (when custom-query
                                (when (do-drop-new-control
                                  app content data
                                  :win win
                                  :custom-query custom-query)
                                  (incf-next-id content))))
                            :width 500
                            :height 300
                            :rows 5
                            :size 40
                            :title "Custom HTML Control"
                            :default-value (getf control-record :create-content)))
            ((or (eq control-type-name :custom-panel)
                 (eq control-type-name :custom-control))
              (input-dialog win "Enter panel create function name:"
                            (lambda (custom-query)
                              (when custom-query
                                (when (do-drop-new-control
                                  app content data
                                  :win win
                                  :custom-query custom-query)
                                  (incf-next-id content))))
                            :width 500
                            :height 300
                            :rows 5
                            :size 40
                            :title "Custom Control"
                            :default-value (getf control-record :create-content)))
            ((eq control-type-name :custom-block)
              (input-dialog win "Enter inner html of block:"
                            (lambda (custom-query)
                              (when custom-query
                                (when (do-drop-new-control
                                  app content data
                                  :win win
                                  :custom-query custom-query)
                                  (incf-next-id content))))
                            :width 500
                            :height 300
                            :rows 5
                            :size 40
                            :title "Custom HTML Block"
                            :default-value (getf control-record :create-content)))
            (t
              (do-drop-new-control app content data :win win))))))

(defun do-drop-new-control (app content data &key win custom-query)
  "Create new control dropped at event DATA on CONTENT of WIN,
return t on success"
  ;; create control
  (let* ((control-record    (control-info (value (select-tool app))))
         (control-type-name (getf control-record :name))
         (positioning       (cond ((or (getf data :ctrl-key)
                                       (getf data :meta-key))
                                    :static)
                                  ((getf control-record :positioning)
                                    (getf control-record :positioning))
                                  (t
                                    :absolute)))
         (auto-parent       (attribute content "data-clog-auto-parent"))
         (parent            (if (getf data :shift-key)
                                (current-control app)
                                (when auto-parent
                                  (get-from-control-list app (html-id content) auto-parent))))
         (control           (create-control (if parent
                                                parent
                                                content)
                                            content
                                            control-record
                                            (format nil "CLOGB~A~A"
                                                    (get-universal-time)
                                                    (next-id content))
                                            :custom-query custom-query)))
    (cond (control
            ;; panel directly clicked with a control type selected
            ;; setup control
            (setf (attribute control "data-clog-name")
                  (format nil "~A-~A" control-type-name (next-id content)))
            (setf (value (select-tool app)) "")
            (setf (box-sizing control) :content-box)
            (setf (positioning control) positioning)
            (set-geometry control
                          :left (getf data :x)
                          :top (getf data :y))
            (when (equalp (attribute control "data-clog-composite-control") "undefined")
              (add-sub-controls control content :win win))
            (setup-control content control :win win)
            (select-control control)
            (on-populate-control-list-win content :win win)
            (jquery-execute (get-placer content) "trigger('clog-builder-snap-shot')")
            t)
          (t
            ;; panel directly clicked with select tool or no control type to add
            (deselect-current-control app)
            (on-populate-control-properties-win content :win win)
            (on-populate-control-list-win content :win win)
            nil))))

(defun setup-control (content control &key win)
  "Setup CONTROL by creating pacer and setting up events for manipulation"
  (let ((app      (connection-data-item content "builder-app-data"))
        (panel-id (html-id content))
        (touch-x  0)
        (touch-y  0)
        (last-w   0)
        (last-h   0)
        (mv-state :off)
        (placer   (create-div control
                              :class "placer"
                              :style "position:absolute;box-sizing:content-box;"
                              :html-id (format nil "p-~A" (html-id control)))))
    (add-to-control-list app panel-id control)
    (setf (attribute placer "data-panel-id") panel-id)
    ;; setup placer
    (adjust-placer control placer)
    (setf (tab-index placer) "-1") ; must have a tab-index to accept keyboard input
    (place-after control placer)
    (set-on-key-down placer
                     (lambda (obj data)
                       (declare (ignore obj))
                       (let ((key   (getf data :key))
                             (ctrl  (getf data :ctrl-key))
                             (meta  (getf data :meta-key))
                             (shift (getf data :shift-key)))
                         (cond ((equal key "ArrowUp")
                                 (if shift
                                     (set-geometry control :height (1- (client-height control)))
                                     (set-geometry control :top (1- (position-top control)))))
                               ((equal key "ArrowDown")
                                 (if shift
                                     (set-geometry control :height (+ (client-height control) 2))
                                     (set-geometry control :top (+ (position-top control) 2))))
                               ((equal key "ArrowRight")
                                 (if shift
                                     (set-geometry control :width (+ (client-width control) 2))
                                     (set-geometry control :left (+ (position-left control) 2))))
                               ((equal key "ArrowLeft")
                                 (if shift
                                     (set-geometry control :width (1- (client-width control)))
                                     (set-geometry control :left (1- (position-left control)))))
                               ((and (equal key "c")
                                     (or meta ctrl))
                                 (blur placer))
                               ((and (equal key "v")
                                     (or meta ctrl))
                                 (blur placer))
                               ((and (equal key "x")
                                     (or meta ctrl))
                                 (blur placer)))
                         (adjust-placer control placer)
                         (jquery-execute placer "trigger('clog-builder-snap-shot')")
                         (set-properties-after-geomentry-change control))))
    (flet ((mouse-move (obj data)
             (set-geometry control
                           :top (+ last-h
                                   (- (getf data :screen-y) touch-y))
                           :left (+ last-w
                                    (- (getf data :screen-x) touch-x)))
             (set-geometry placer :units ""
                           :top (top control)
                           :left (left control))
             (set-properties-after-geomentry-change obj))
           (mouse-size (obj data)
             (set-geometry control
                           :width (+ last-w
                                     (- (getf data :screen-x) touch-x))
                           :height (+ last-h
                                      (- (getf data :screen-y) touch-y)))
             (set-geometry placer :units ""
                           :width (client-width control)
                           :height (client-height control))
             (set-properties-after-geomentry-change obj)))
      (set-on-touch-move placer (lambda (obj data)
                                  (when (eq mv-state :point)
                                    (setf mv-state :touch))
                                  (when (eq mv-state :touch)
                                    (mouse-move obj data)))
                         :cancel-event t)
      (set-on-pointer-move placer (lambda (obj data)
                                    (when (eq mv-state :size)
                                      (mouse-size obj data))
                                    (when (eq mv-state :point)
                                      (mouse-move obj data)))
                           :cancel-event t)
      (set-on-pointer-cancel placer (lambda (obj data)
                                      (declare (ignore obj data))
                                      (setf mv-state :off)
                                      (set-geometry placer :units ""
                                                    :top (top control)
                                                    :left (left control))))
      (set-on-pointer-up placer (lambda (obj data)
                                  (declare (ignore obj data))
                                  (setf mv-state :off)
                                  (setf (background-color placer) "")
                                  (select-control control)
                                  (jquery-execute placer "trigger('clog-builder-snap-shot')")
                                  (set-properties-after-geomentry-change control))
                         :cancel-event t)
      (set-on-pointer-down placer
                         (lambda (obj data)
                           (declare (ignore obj))
                           (setf mv-state :off)
                           (let ((last  (current-control app))
                                 (shift (getf data :shift-key)))
                             (if (and (select-tool app)
                                  (not (equal (value (select-tool app)) "")))
                                 (when (do-drop-new-control app content data :win win)
                                   (incf-next-id content)))
                             (cond ((and last
                                         shift)
                                     (let* ((control1 last)
                                            (control2 control)
                                            (placer1  (get-placer control1))
                                            (placer2  (get-placer control2)))
                                       (place-inside-bottom-of control1 control2)
                                       (place-after control2 placer2)
                                       (place-after control2 placer2)
                                       (adjust-placer control1 placer1)
                                       (adjust-placer control2 placer2))
                                     (select-control control)
                                     (on-populate-control-properties-win content :win win)
                                     (on-populate-control-list-win content :win win))
                                   ((and last
                                         (or (> (getf data :x) (- (client-width control) 5))
                                             (> (getf data :y) (- (client-height control) 5))))
                                     (setf mv-state :size)
                                     (setf (background-color placer) (rgba 0 255 0 0.10))
                                     (setf last-w (client-width control))
                                     (setf last-h (client-height control))
                                     (setf touch-x (getf data :screen-x))
                                     (setf touch-y (getf data :screen-y)))
                                   (last
                                     (setf mv-state :point)
                                     (setf (background-color placer) (rgba 0 0 255 0.10))
                                     (setf last-w (position-left placer))
                                     (setf last-h (position-top placer))
                                     (setf touch-x (getf data :screen-x))
                                     (setf touch-y (getf data :screen-y)))
                                   (t
                                     (select-control control)))
                             (when win
                               (window-focus win))))
                           :cancel-event t
                           :capture-pointer t))
    (set-on-mouse-double-click placer
                               (lambda (obj data)
                                 (declare (ignore obj data))
                                 (setf mv-state :off)
                                 (setf (hiddenp placer) t)
                                 (on-populate-control-list-win content :win win)))))

(defun on-populate-loaded-window (content &key win)
  "Setup html imported in to CONTENT for use with Builder"
  (with-sync-event (content)
    (add-sub-controls content content :win win)))

(defun set-property-display (control property value)
  "Set property in the currently displayed property panel"
  (js-execute control (format nil "$('.clog-prop-~A').text('~A')"
                              property value)))

(defun set-properties-after-geomentry-change (control)
  "Set properties window geometry setting"
  (set-property-display control "top" (top control))
  (set-property-display control "left" (left control))
  (set-property-display control "right" (right control))
  (set-property-display control "bottom" (bottom control))
  (set-property-display control "width" (client-width control))
  (set-property-display control "height" (client-height control)))

;; Control selection utilities

(defun get-placer (control)
  "Get placer for CONTROL. A placer is a div placed on top of CONTROL and
prevents access to use or activate the control directy and allows
manipulation of the control's location and size."
  (when control
    (clog::make-clog-element (clog::connection-id control)
                             (format nil "p-~A" (html-id control))
                             :clog-type 'clog:clog-element)))

(defun deselect-current-control (app)
  "Remove selection on current control and remove visual ques on its placer."
  (when (current-control app)
    (let ((placer (get-placer (current-control app))))
      (set-border placer (unit "px" 0) :none :blue))
    (setf (current-control app) nil)))

(defun delete-current-control (app panel-id html-id)
  "Delete the current control"
  (remove-from-control-list app panel-id html-id)
  (destroy (get-placer (current-control app)))
  (destroy (current-control app))
  (setf (current-control app) nil)
  (remove-deleted-from-control-list app panel-id))

(defun adjust-placer (control placer)
  "Adjust placer geomatry to fit control"
  (set-geometry placer
                :top    (position-top control)
                :left   (position-left control)
                :width  (client-width control)
                :height (client-height control)))

(defun select-control (control)
  "Select CONTROL as the current control and highlight its placer.
The actual original clog object used for creation must be used and
not a temporarily attached one when using select-control."
  (let ((app    (connection-data-item control "builder-app-data"))
        (placer (get-placer control)))
    (unless (eq control (current-control app))
      (deselect-current-control app)
      (adjust-placer control placer)
      (setf (current-control app) control)
      (set-border placer (unit "px" 2) :solid :blue)
      (focus placer)
      (on-populate-control-properties-win control))))

(defun add-sub-controls (parent content &key win paste)
  "Setup html imported in to CONTENT starting with PARENT for use with Builder"
  (let ((panel-uid (get-universal-time)))
    ;; Assign any elements with no id, an id, name and type
    (let ((tmp (format nil
                       "var clog_id=~A; var clog_nid=1;~
      $(~A).find('*').each(function() {var e=$(this);~
        var t=e.prop('tagName').toLowerCase(); var p=e.attr('data-clog-type');~
        if((e.attr('id') === undefined) && (e.attr('data-clog-name') === undefined))~
           {e.attr('id','CLOGB'+clog_id++);~
            e.attr('data-clog-name','none-'+t+'-'+clog_nid++)}~
        if(e.attr('id') === undefined){e.attr('id','CLOGB'+clog_id++)}~
        if(e.attr('data-clog-name') === undefined){e.attr('data-clog-name',e.attr('id'))}~
        ~A ~
        ~{~A~}~
        if(e.attr('data-clog-type') === undefined){e.attr('data-clog-type','span')}})"
                       (1+ panel-uid)
                       (jquery parent)
                       (if paste
                           (prog1
                               (format nil "e.attr('data-clog-name', e.attr('data-clog-name')+'-'+~A);"
                                (next-id content))
                             (incf-next-id content))
                           "")
                       (mapcar (lambda (l)
                                 (format nil "if(p === undefined && t=='~A'){e.attr('data-clog-type','~A')}"
                                         (getf l :tag) (getf l :control)))
                               *import-types*))))
      (js-execute parent tmp))
    (unless paste
      (let* ((data (first-child content))
             (name    (attribute data "data-clog-title"))
             (next-id (attribute data "data-clog-next-id"))
             (slots   (attribute data "data-custom-slots"))
             (package (attribute data "data-in-package")))
        (unless (equalp next-id "undefined")
          (setf-next-id content next-id))
        (unless (equalp package "undefined")
          (setf (attribute content "data-in-package") package))
        (unless (equalp slots "undefined")
          (setf (attribute content "data-custom-slots") slots))
        (unless (equalp name "undefined")
          (setf (attribute content "data-clog-name") name)
          (destroy data))))
    (let ((dom (list-of-children parent))
          dct)
      (labels ((tr (control)
                 (unless (equal (html-id control) "undefined")
                   (setf dct (attribute control "data-clog-type"))
                   (unless (equal dct "undefined")
                     (change-class control (getf (control-info dct) :clog-type)))
                   (when (getf (control-info dct) :on-load)
                     (funcall (getf (control-info dct) :on-load) control (control-info dct)))
                   (setup-control content control :win win)))
               (ll (lst)
                   (mapcar (lambda (l)
                             (if (listp l)
                                 (if (listp (first l))
                                     (tr (first l))
                                     (ll l))
                                 (tr l)))
                           lst)))
        (ll dom)))))

;; Panel Windows

(defun on-new-builder-panel-ext (obj &key open-file popup open-ext)
  (open-window (window (connection-body obj))
               (if open-file
                   (format nil "/panel-editor?open-panel=~A~A"
                           open-file (if open-ext
                                         (format nil "&open-ext=~A" open-ext)
                                         ""))
                   (format nil "/panel-editor?open-panel=%20~A"
                           (if open-ext
                               (format nil "&open-ext=~A" open-ext)
                               "")))
               :specs (if (or popup *open-external-panels-in-popup*)
                          "width=1280,height=700"
                          "")
               :name "_blank"))

(defun on-new-builder-panel (obj &key (open-file nil) open-ext)
  "Open new panel"
  (unless (and open-file
               (window-to-top-by-param obj open-file))
    (let* ((app (connection-data-item obj "builder-app-data"))
           (*menu-bar-class*           *builder-menu-bar-class*)
           (*menu-bar-drop-down-class* *builder-menu-bar-drop-down-class*)
           (*menu-item-class*          *builder-menu-item-class*)
           (*menu-window-select-class* *builder-menu-window-select-class*)
           (*default-title-class*      *builder-title-class*)
           (*default-border-class*     *builder-border-class*)
           ext-panel
           (win (create-gui-window obj
                                   :client-movement *client-side-movement*))
           (box (create-panel-box-layout (window-content win)
                                         :left-width 0 :right-width 0
                                         :top-height 70 :bottom-height 0))
           (menu     (create-gui-menu-bar (top-panel box) :main-menu nil))
           (m-file   (create-gui-menu-drop-down menu :content "File"))
           (m-load   (create-gui-menu-item m-file :content "load"))
           (m-reload (create-gui-menu-item m-file :content "reload"))
           (m-save   (create-gui-menu-item m-file :content "save (cmd/ctrl-s)"))
           (m-saveas (create-gui-menu-item m-file :content "save as.."))
           (m-reopnp (create-gui-menu-item m-file :content "save, close and reopen as panel"))
           (m-reopn  (create-gui-menu-item m-file :content "save, close and popup this panel"))
           (m-reopnb (create-gui-menu-item m-file :content "save, close and popup this panel custom boot file"))
           (m-reopnh (create-gui-menu-item m-file :content "save, close and popup this panel no css"))
           (m-edit   (create-gui-menu-drop-down menu :content "Edit"))
           ;;(m-undo   (create-gui-menu-item m-edit :content "undo"))
           ;;(m-redo   (create-gui-menu-item m-edit :content "redo"))
           (m-copy   (create-gui-menu-item m-edit :content "copy"))
           (m-paste  (create-gui-menu-item m-edit :content "paste"))
           (m-cut    (create-gui-menu-item m-edit :content "cut"))
           (m-del    (create-gui-menu-item m-edit :content "delete"))
           (m-lisp   (create-gui-menu-drop-down menu :content "Lisp"))
           (m-rndr   (create-gui-menu-item m-lisp :content "render form to lisp"))
           (m-rndras (create-gui-menu-item m-lisp :content "render form to lisp as..."))
           (m-eval   (create-gui-menu-item m-lisp :content "evaluate"))
           (m-test   (create-gui-menu-item m-lisp :content "evaluate and test"))
           (m-events (create-gui-menu-drop-down menu :content "Controls"))
           (tmp1     (create-gui-menu-item m-events :content "show control properties"  :on-click 'on-show-control-properties-win))
           (tmp2     (create-gui-menu-item m-events :content "show controls window"     :on-click 'on-show-control-list-win))
           (tmp3     (create-gui-menu-item m-events :content "show CLOG events"         :on-click 'on-show-control-events-win))
           (tmp4     (create-gui-menu-item m-events :content "show JavaScript events"   :on-click 'on-show-control-js-events-win))
           (tmp5     (create-gui-menu-item m-events :content "show ParenScript events"  :on-click 'on-show-control-ps-events-win))
           (m-view   (create-gui-menu-drop-down menu :content "View"))
           (m-vsrc   (create-gui-menu-item m-view :content "save and open clog source"))
           (m-vsrcl  (create-gui-menu-item m-view :content "save, render and open lisp source"))
           (m-html   (create-gui-menu-item m-view :content "view HTML"))
           (m-htmlq  (create-gui-menu-item m-view :content "view as quoted HTML"))
           (m-help   (create-gui-menu-drop-down menu :content "Help"))
           (m-helpk  (create-gui-menu-item m-help :content "quick start"))
           (tool-bar  (create-div (top-panel box) :class *builder-title-class*))
           (btn-class *builder-icons-class*)
           (btn-copy  (create-img tool-bar :alt-text "copy"     :url-src img-btn-copy  :class btn-class))
           (btn-paste (create-img tool-bar :alt-text "paste"    :url-src img-btn-paste :class btn-class))
           (btn-cut   (create-img tool-bar :alt-text "cut"      :url-src img-btn-cut   :class btn-class))
           (btn-del   (create-img tool-bar :alt-text "delete"   :url-src img-btn-del   :class btn-class))
           ;;(btn-undo  (create-img tool-bar :alt-text "undo"     :url-src img-btn-undo  :class btn-class))
           ;;(btn-redo  (create-img tool-bar :alt-text "redo"     :url-src img-btn-redo  :class btn-class))
           (btn-eval  (create-img tool-bar :alt-text "evaluate" :url-src img-btn-sim   :class btn-class))
           (btn-test  (create-img tool-bar :alt-text "test"     :url-src img-btn-test  :class btn-class))
           (btn-rndr  (create-img tool-bar :alt-text "render"   :url-src img-btn-rndr  :class btn-class))
           (btn-save  (create-img tool-bar :alt-text "save"     :url-src img-btn-save  :class btn-class))
           (btn-load  (create-img tool-bar :alt-text "load"     :url-src img-btn-load  :class btn-class))
           (cbox      (create-form-element tool-bar :checkbox :class "w3-margin-left"))
           (cbox-lbl  (create-label tool-bar :content "&nbsp;auto render" :label-for cbox))
           (spacer    (create-span tool-bar :content "&nbsp;&nbsp;&nbsp;"))
           (btn-help  (create-span tool-bar :content "?" :class "w3-tiny w3-ripple"))
           (content   (center-panel box))
           (undo-chain       nil)
           (redo-chain       nil)
           (is-dirty         nil)
           (last-date        nil)
           (file-name        "")
           (render-file-name "")
           (panel-id  (html-id content)))
      (declare (ignore spacer tmp1 tmp2 tmp3 tmp4 tmp5))
      (set-geometry win
                    :top (menu-bar-height obj) :bottom 305
                    :right 405 :left (+ *builder-left-panel-size* 5)
                    :width "" :height "")
      (set-geometry win :width (width win) :height (height win) :bottom "" :right "")
      (setf (style content "user-select") "none")
      (add-class menu "w3-small")
      (setf (overflow (top-panel box)) :visible) ; let menus leave the top panel
      (add-class (top-panel box) *builder-title-class*)
      (setf (background-color (top-panel box)) :black)
      (setf (checkedp cbox) t)
      (setf (advisory-title btn-copy) "copy")
      (setf (advisory-title btn-paste) "paste")
      (setf (advisory-title btn-cut) "cut")
      (setf (advisory-title btn-del) "delete")
      ;;(setf (advisory-title btn-undo) "undo")
      ;;(setf (advisory-title btn-redo) "redo")
      (setf (advisory-title btn-eval) "evaluate")
      (setf (advisory-title btn-test) "test")
      (setf (advisory-title btn-rndr) "render to lisp - shift-click render as...")
      (setf (advisory-title btn-save) "save - shift-click save as...")
      (setf (advisory-title btn-load) "load")
      (setf (advisory-title cbox) "when checked render on save")
      (setf (advisory-title cbox-lbl) "when checked render on save")
      (setf (height btn-copy) "12px")
      (setf (height btn-paste) "12px")
      (setf (height btn-cut) "12px")
      (setf (height btn-del) "12px")
      ;;(setf (height btn-undo) "12px")
      ;;(setf (height btn-redo) "12px")
      (setf (height btn-eval) "12px")
      (setf (height btn-test) "12px")
      (setf (height btn-rndr) "12px")
      (setf (height btn-save) "12px")
      (setf (height btn-load) "12px")
      (setf (height btn-help) "12px")
      (when (or open-ext
                *open-panels-as-popups*)
        (multiple-value-bind (pop pop-win)
                             (if (typep open-ext 'string)
                                 (progn
                                   (enable-clog-popup :path "/customboot" :boot-file open-ext)
                                   (open-clog-popup obj :path "/customboot"
                                                    :specs "width=640,height=480"))
                                 (open-clog-popup obj :specs "width=640,height=480"))
          (when pop
            (load-script (html-document (connection-body pop)) "/builder-js/beautify.js" :load-only-once t)
            (load-script (html-document (connection-body pop)) "/builder-js/beautify-css.js" :load-only-once t)
            (load-script (html-document (connection-body pop)) "/builder-js/beautify-html.js" :load-only-once t)
            (let ((msg (create-button content :content "Panel is external. Click to bring to front.")))
              (set-geometry msg :units "%" :height 100 :width 100)
              (set-on-click content
                            (lambda (obj)
                              (declare (ignore obj))
                              (focus pop-win))))
            (setf ext-panel pop)
            (cond ((eq open-ext :custom)
                    (load-css (html-document pop) "/css/jquery-ui.css")
                    (load-script (html-document pop) "/js/jquery-ui.js"))
                  (t
                    (clog-gui-initialize pop)
                    (clog-web-initialize pop :w3-css-url nil)))
            (setf (connection-data-item pop "builder-app-data") app)
            (let ((nbox (create-panel-box-layout pop
                                                 :left-width 0 :right-width 0
                                                 :top-height 0 :bottom-height 0)))
              (setf box nbox)
              (setf content (center-panel nbox))
              (setf panel-id (html-id content))
              (set-on-focus (window pop)
                            (lambda (obj)
                              (declare (ignore obj))
                              (setf (title (html-document pop)) (attribute content "data-clog-name"))))
              (set-on-before-unload (window pop)
                                    (lambda (obj)
                                      (declare (ignore obj))
                                      (deselect-current-control app)
                                      (on-populate-control-events-win content)
                                      (on-populate-control-list-win content :win win :clear t)
                                      (on-populate-control-properties-win content :win win :clear t)
                                      (setf content nil)
                                      (setf ext-panel nil)
                                      (window-close win)))
              (set-on-click (create-gui-menu-item m-file :content "export as a boot html")
                            (lambda (obj)
                              (server-file-dialog obj "Export as a Boot HTML" "./"
                                                  (lambda (filename)
                                                    (when filename
                                                      (maphash
                                                        (lambda (html-id control)
                                                          (declare (ignore html-id))
                                                          (place-inside-bottom-of (bottom-panel box)
                                                                                  (get-placer control)))
                                                        (get-control-list app panel-id))
                                                      ;; needs to clear data attrs
                                                      (save-body-to-file filename :body pop :if-exists :rename)
                                                      (maphash
                                                        (lambda (html-id control)
                                                          (declare (ignore html-id))
                                                          (place-after control (get-placer control)))
                                                        (get-control-list app panel-id)))))))
              (focus pop-win)))))
      (setf-next-id content 1)
      (setf (css-class-name content) *builder-panel-class*)
      (setf (overflow content) :auto)
      (init-control-list app panel-id)
      ;; Setup panel window
      (let ((panel-name (format nil "panel-~A" (incf (next-panel-id app)))))
        (setf (window-title win) panel-name)
        (setf (attribute content "data-clog-name") panel-name))
      (setf (attribute content "data-clog-type") "clog-data")
      (setf (attribute content "data-in-package") "clog-user")
      (setf (attribute content "data-custom-slots") "")
      ;; activate associated windows on open
      (on-show-control-events-win win)
      (on-show-control-properties-win win)
      (on-show-control-list-win win)
      (on-populate-control-properties-win content :win win)
      (on-populate-control-list-win content :win win)
      ;; setup window events
      (set-on-window-focus win
                           (lambda (obj)
                             (declare (ignore obj))
                             (unless (eq (last-panel-editor app) win)
                               (progn
                                 (on-populate-control-properties-win content :win win)
                                 (on-populate-control-list-win content :win win)
                                 (setf (last-panel-editor app) win)))))
      (set-on-window-close win
                           (lambda (obj)
                             (declare (ignore obj))
                             (deselect-current-control app)
                             (on-populate-control-events-win content)
                             (on-populate-control-list-win content :win win :clear t)
                             (on-populate-control-properties-win content :win win :clear t)
                             (setf (current-control app) nil)
                             (destroy-control-list app panel-id)
                             (when ext-panel
                               (close-window (window ext-panel)))))
      (set-on-window-size-done win
                               (lambda (obj)
                                 (declare (ignore obj))
                                 (on-populate-control-properties-win content :win win)))
      (set-on-event content "clog-builder-snap-shot"
                    (lambda (obj)
                      (declare (ignore obj))
                      (setf is-dirty t)
                      (setf redo-chain nil)
                      (push (panel-snap-shot content panel-id (bottom-panel box)) undo-chain)
                      (when (current-control app)
                        (focus (get-placer (current-control app))))))
      ;; setup tool bar events
      (set-on-click btn-help 'on-quick-start)
      (set-on-click m-helpk 'on-quick-start)
      (labels (;; copy
               (copy (obj)
                 (when (current-control app)
                   (maphash
                     (lambda (html-id control)
                       (declare (ignore html-id))
                       (place-inside-bottom-of (bottom-panel box)
                                               (get-placer control)))
                     (get-control-list app panel-id))
                   (setf (copy-buf app)
                         (js-query content
                                   (format nil
                                           "var z=~a.clone(); z=$('<div />').append(z);~
       z.find('*').each(function(){~
         if($(this).attr('data-clog-composite-control') == 't'){$(this).text('')}~
         if($(this).attr('id') !== undefined && ~
           $(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~
       html_beautify (z.html(),{'wrap_line_length': '80'})"
                                           (jquery (current-control app)))))
                   (system-clipboard-write obj (copy-buf app))
                   (let ((c (create-text-area (window-content (copy-history-win app))
                                              :value (copy-buf app)
                                              :class "w3-input")))
                     (place-inside-top-of (window-content (copy-history-win app)) c))
                   (maphash
                     (lambda (html-id control)
                       (declare (ignore html-id))
                       (place-after control (get-placer control)))
                     (get-control-list app panel-id))))
               ;; paste
               (paste (obj)
                 (let ((buf (or (system-clipboard-read obj)
                                (copy-buf app))))
                   (when buf
                     (let ((control (create-control content content
                                                    `(:name "custom"
                                                            :create-type :paste)
                                                    (format nil "CLOGB~A~A"
                                                            (get-universal-time)
                                                            (next-id content))
                                                    :custom-query buf)))
                       (setf (attribute control "data-clog-name")
                             (format nil "~A-~A" "copy" (next-id content)))
                       (incf-next-id content)
                       (add-sub-controls control content :win win :paste t)
                       (let ((cr (control-info (attribute control "data-clog-type"))))
                         (when (getf cr :on-load)
                           (funcall (getf cr :on-load) control cr)))
                       (setup-control content control :win win)
                       (select-control control)
                       (on-populate-control-list-win content :win win)
                       (jquery-execute (get-placer content) "trigger('clog-builder-snap-shot')")))))
               ;; delete
               (del (obj)
                 (declare (ignore obj))
                 (when (current-control app)
                   (delete-current-control app panel-id (html-id (current-control app)))
                   (on-populate-control-properties-win content :win win)
                   (on-populate-control-list-win content :win win)
                   (jquery-execute (get-placer content) "trigger('clog-builder-snap-shot')")))
               (cut (obj)
                 (copy obj)
                 (del obj))
               (undo (obj)
                 (declare (ignore obj))
                 (when undo-chain
                   (setf (inner-html content)
                         (let ((val (pop undo-chain)))
                           (push val redo-chain)
                           val))
                   (clrhash (get-control-list app panel-id))
                   (on-populate-loaded-window content :win win)
                   (setf (window-title win) (attribute content "data-clog-name"))
                   (on-populate-control-properties-win content :win win)
                   (on-populate-control-list-win content :win win)))
               (redo (obj)
                 (declare (ignore obj))
                 (when redo-chain
                   (setf (inner-html content)
                         (let ((val (pop redo-chain)))
                           (push val undo-chain)
                           val))
                   (clrhash (get-control-list app panel-id))
                   (on-populate-loaded-window content :win win)
                   (setf (window-title win) (attribute content "data-clog-name"))
                   (on-populate-control-properties-win content :win win)
                   (on-populate-control-list-win content :win win))))
        ;; set up del/cut/copy/paste handlers
        ;;(set-on-click btn-undo #'undo)
        ;;(set-on-click m-undo #'undo)
        ;;(set-on-click btn-redo #'redo)
        ;;(set-on-click m-redo #'redo)
        (set-on-copy content #'copy)
        (set-on-click btn-copy #'copy)
        (set-on-click m-copy #'copy)
        (set-on-paste content #'paste)
        (set-on-click btn-paste #'paste)
        (set-on-click m-paste #'paste)
        (set-on-click btn-del #'del)
        (set-on-click m-del #'del)
        (set-on-cut content #'cut)
        (set-on-click btn-cut #'cut)
        (set-on-click m-cut #'cut))
      (labels ((open-file-name (fname)
                 (setf file-name fname)
                 (setf last-date (file-write-date fname))
                 (setf render-file-name (format nil "~A~A.lisp"
                                                (directory-namestring file-name)
                                                (pathname-name file-name)))
                 (setf (inner-html content)
                       (or (read-file fname :clog-obj obj)
                           ""))
                 (setf is-dirty nil)
                 (clrhash (get-control-list app panel-id))
                 (on-populate-loaded-window content :win win)
                 (when ext-panel
                   (setf (title (html-document ext-panel)) (attribute content "data-clog-name")))
                 (setf (window-param win) fname)
                 (setf (window-title win) (attribute content "data-clog-name"))
                 (on-populate-control-properties-win content :win win)
                 (on-populate-control-list-win content :win win))
               (load-file (obj)
                 (server-file-dialog obj "Load Panel" (directory-namestring (if (equal file-name "")
                                                                                (current-project-dir app)
                                                                                file-name))
                                     (lambda (fname)
                                       (window-focus win)
                                       (when fname
                                         (open-file-name fname))))))
        (when open-file
          (open-file-name open-file))
        (set-on-click m-reload (lambda (obj)
                                 (declare (ignore obj))
                                 (unless (equal file-name "")
                                   (open-file-name file-name))))
        (set-on-click btn-load #'load-file)
        (set-on-click m-load #'load-file))
      (labels ((do-save (obj fname data &key render)
                 (declare (ignore data))
                 (setf file-name fname)
                 (setf render-file-name (format nil "~A~A.lisp"
                                                (directory-namestring file-name)
                                                (pathname-name file-name)))
                 (add-class btn-save "w3-animate-top")
                 (save-panel fname content panel-id (bottom-panel box))
                 (setf last-date (file-write-date fname))
                 (when (or (checkedp cbox) render)
                   (add-class btn-rndr "w3-animate-top")
                   (write-file (render-clog-code content (bottom-panel box))
                               render-file-name :clog-obj obj)
                   (sleep .5)
                   (remove-class btn-rndr "w3-animate-top"))
                 (sleep .5)
                 (remove-class btn-save "w3-animate-top")
                 (cond ((eq is-dirty :close)
                         (setf is-dirty nil)
                         (window-close win))
                       (t
                         (setf is-dirty nil))))
               (save (obj data &key save-as render)
                 (cond ((or (equal file-name "")
                            save-as
                            (getf data :shift-key))
                         (when (equal file-name "")
                           (setf file-name (format nil "~A~A.clog"
                                                   (current-project-dir app)
                                                   (attribute content "data-clog-name"))))
                         (server-file-dialog obj "Save Panel As.." file-name
                                             (lambda (fname)
                                               (window-focus win)
                                               (when fname
                                                 (setf file-name fname)
                                                 (do-save obj fname data :render render)))
                                             :time-out 600
                                             :initial-filename file-name))
                       (t
                         (if (eql last-date (file-write-date file-name))
                             (do-save obj file-name data :render render)
                             (confirm-dialog obj "Panel changed on file system. Save?"
                                             (lambda (result)
                                               (when result
                                                 (do-save obj file-name data))))))))
               (eval-test (obj &key (test t))
                 (do-eval obj (render-clog-code content (bottom-panel box))
                          (attribute content "data-clog-name")
                          :test test
                          :package (attribute content "data-in-package")))
               (render (obj data &key save-as)
                 (cond ((or (equal render-file-name "")
                            save-as
                            (getf data :shift-key))
                         (when (equal render-file-name "")
                           (if (equal file-name "")
                               (setf render-file-name (format nil "~A.lisp" (attribute content "data-clog-name")))
                               (setf render-file-name (format nil "~A~A.lisp"
                                                              (directory-namestring file-name)
                                                              (pathname-name file-name)))))
                         (server-file-dialog obj "Render As.." render-file-name
                                             (lambda (fname)
                                               (window-focus win)
                                               (when fname
                                                 (setf render-file-name fname)
                                                 (add-class btn-rndr "w3-animate-top")
                                                 (write-file (render-clog-code content (bottom-panel box))
                                                             fname :clog-obj obj)
                                                 (sleep .5)
                                                 (remove-class btn-rndr "w3-animate-top")))
                                             :initial-filename render-file-name))
                       (t
                         (add-class btn-rndr "w3-animate-top")
                         (write-file (render-clog-code content (bottom-panel box))
                                     render-file-name :clog-obj obj)
                         (sleep .5)
                         (remove-class btn-rndr "w3-animate-top")))))
        (set-on-window-can-close win
                                 (lambda (obj)
                                   (cond (is-dirty
                                           (confirm-dialog win "Save panel?"
                                                           (lambda (result)
                                                             (cond (result
                                                                     (setf is-dirty :close)
                                                                     (save obj nil))
                                                                   (t
                                                                     (setf is-dirty nil)
                                                                     (window-close win))))
                                                           :ok-text "Yes" :cancel-text "No")
                                           nil)
                                         (t
                                           t))))
        (set-on-mouse-click btn-save
                            (lambda (obj data)
                              (save obj data)))
        (set-on-click m-save (lambda (obj)
                               (save obj nil)))
        (set-on-click m-vsrc (lambda (obj)
                               (when is-dirty
                                 (save obj nil))
                               (on-open-file obj :open-file file-name)))
        (set-on-click m-vsrcl (lambda (obj)
                                (save obj nil :render t)
                                (on-open-file obj :open-file render-file-name)))
        (flet ((render-html ()
                 (let (result)
                   (maphash
                     (lambda (html-id control)
                       (declare (ignore html-id))
                       (place-inside-bottom-of (bottom-panel box)
                                               (get-placer control)))
                     (get-control-list app panel-id))
                   (setf result (pprint-as-html content))
                   (maphash
                     (lambda (html-id control)
                       (declare (ignore html-id))
                       (place-after control (get-placer control)))
                     (get-control-list app panel-id))
                   result)))
          (set-on-click m-html (lambda (obj)
                                 (on-open-file obj :force-mode "ace/mode/html" :text (render-html))))
          (set-on-click m-htmlq (lambda (obj)
                                  (on-open-file obj :force-mode "ace/mode/html" :text
                                                (ppcre:regex-replace-all "\""
                                                                         (render-html)
                                                                         "\\\"")))))
        (set-on-click m-saveas (lambda (obj)
                                 (save obj nil :save-as t)))
        (set-on-click m-reopn (lambda (obj)
                                (when is-dirty
                                  (save obj nil))
                                (window-close win)
                                (on-new-builder-panel obj :open-file file-name :open-ext t)))
        (set-on-click m-reopnh (lambda (obj)
                                 (when is-dirty
                                   (save obj nil))
                                 (window-close win)
                                 (on-new-builder-panel obj :open-file file-name :open-ext :custom)))
        (set-on-click m-reopnb (lambda (obj)
                                 (input-dialog obj "Boot file Name?"
                                               (lambda (file)
                                                 (when file
                                                   (when is-dirty
                                                     (save obj nil))
                                                   (window-close win)
                                                   (on-new-builder-panel obj :open-file file-name :open-ext file))))))
        (set-on-click m-reopnp (lambda (obj)
                                 (when is-dirty
                                   (save obj nil))
                                 (window-close win)
                                 (on-new-builder-panel obj :open-file file-name)))
        (set-on-click btn-eval (lambda (obj)
                                 (eval-test obj :test nil)))
        (set-on-click m-eval (lambda (obj)
                               (eval-test obj :test nil)))
        (set-on-click btn-test #'eval-test)
        (set-on-click m-test #'eval-test)
        (set-on-mouse-click btn-rndr (lambda (obj data) (render obj data)))
        (set-on-click m-rndr (lambda (obj) (render obj nil)))
        (set-on-click m-rndras (lambda (obj) (render obj nil :save-as t))))
      (set-on-mouse-down content
                         (lambda (obj data)
                           (declare (ignore obj))
                           (when (drop-new-control app content data :win win)
                             (setf is-dirty t)
                             (incf-next-id content)))))))

(defun on-new-builder-page (obj)
  "Open new page"
  (if (or *open-external* *open-external-panels-always*)
      (on-new-builder-panel-ext obj :open-ext t)
      (on-new-builder-panel obj :open-ext t)))

(defun on-new-builder-basic-page (obj)
  "Menu item to open new basic HTML page"
  (if (or *open-external* *open-external-panels-always*)
      (on-new-builder-panel-ext obj :open-ext :custom)
      (on-new-builder-panel obj :open-ext :custom)))

(defun on-new-builder-custom-page (obj)
  (input-dialog obj "Boot file Name?"
                (lambda (file)
                  (when file
                    (if (or *open-external* *open-external-panels-always*)
                        (on-new-builder-panel-ext obj :open-ext file)
                        (on-new-builder-panel obj :open-ext file))))))

(defun on-quick-start (obj)
  "Open quick start help"
  (let* ((*default-title-class*      *builder-title-class*)
         (*default-border-class*     *builder-border-class*)
         (win (create-gui-window obj :title "Quick Start"
                                 :width 600 :height 400
                                 :client-movement *client-side-movement*)))
    (create-quick-start (window-content win))))
