mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
More design work, added popup panels option to project view
This commit is contained in:
David Botton
parent
31f207c28a
commit
bf446f6f9f
8 changed files with 375 additions and 391 deletions
|
|
@ -7,11 +7,11 @@
|
|||
(window-focus (control-events-win app))
|
||||
(let* ((win (create-gui-window obj :title "Control CLOG Events"
|
||||
:left 225
|
||||
:top 480
|
||||
:height 200 :width 645
|
||||
:has-pinner t :client-movement *client-side-movement*))
|
||||
(content (window-content win))
|
||||
status)
|
||||
(set-geometry win :top "" :bottom 0)
|
||||
(setf (current-editor-is-lisp app) t)
|
||||
(set-on-window-focus win
|
||||
(lambda (obj)
|
||||
|
|
@ -42,15 +42,6 @@
|
|||
(set-on-window-size-done win (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(clog-ace:resize (event-editor app))))
|
||||
(panel-mode win t)
|
||||
(set-on-window-focus win
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(panel-mode win t)))
|
||||
(set-on-window-blur win
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(panel-mode win nil)))
|
||||
(set-on-window-close win (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(setf (event-editor app) nil)
|
||||
|
|
@ -65,11 +56,11 @@
|
|||
(window-focus (control-js-events-win app))
|
||||
(let* ((win (create-gui-window obj :title "Control Client JavaScript Events"
|
||||
:left 225
|
||||
:top 700
|
||||
:height 200 :width 645
|
||||
:has-pinner t :client-movement *client-side-movement*))
|
||||
(content (window-content win))
|
||||
status)
|
||||
(set-geometry win :top "" :bottom 0)
|
||||
(setf (current-editor-is-lisp app) nil)
|
||||
(set-on-window-focus win
|
||||
(lambda (obj)
|
||||
|
|
@ -102,15 +93,6 @@
|
|||
(set-on-window-size-done win (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(clog-ace:resize (event-js-editor app))))
|
||||
(panel-mode win t)
|
||||
(set-on-window-focus win
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(panel-mode win t)))
|
||||
(set-on-window-blur win
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(panel-mode win nil)))
|
||||
(set-on-window-close win (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(setf (event-js-editor app) nil)
|
||||
|
|
@ -125,11 +107,11 @@
|
|||
(window-focus (control-ps-events-win app))
|
||||
(let* ((win (create-gui-window obj :title "Control Client ParenScript Events"
|
||||
:left 225
|
||||
:top 700
|
||||
:height 200 :width 645
|
||||
:has-pinner t :client-movement *client-side-movement*))
|
||||
(content (window-content win))
|
||||
status)
|
||||
(set-geometry win :top "" :bottom 0)
|
||||
(setf (current-editor-is-lisp app) nil)
|
||||
(set-on-window-focus win
|
||||
(lambda (obj)
|
||||
|
|
@ -161,15 +143,6 @@
|
|||
(set-on-window-size-done win (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(clog-ace:resize (event-ps-editor app))))
|
||||
(panel-mode win t)
|
||||
(set-on-window-focus win
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(panel-mode win t)))
|
||||
(set-on-window-blur win
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(panel-mode win nil)))
|
||||
(set-on-window-close win (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(setf (event-ps-editor app) nil)
|
||||
|
|
@ -179,75 +152,76 @@
|
|||
|
||||
(defun on-populate-control-events-win (obj)
|
||||
"Populate the control events for the current control"
|
||||
(let* ((app (connection-data-item obj "builder-app-data"))
|
||||
(event-win (control-events-win app))
|
||||
(elist (events-list app))
|
||||
(control (current-control app)))
|
||||
(when event-win
|
||||
(set-on-blur (event-editor app) nil)
|
||||
(set-on-change elist nil)
|
||||
(setf (inner-html elist) "")
|
||||
(remove-attribute elist "data-current-event")
|
||||
(setf (text-value (event-editor app)) "")
|
||||
(setf (clog-ace:read-only-p (event-editor app)) t)
|
||||
(when control
|
||||
(let ((info (control-info (attribute control "data-clog-type"))))
|
||||
(labels ((populate-options (&key (current ""))
|
||||
(set-on-change elist nil)
|
||||
(setf (inner-html elist) "")
|
||||
(add-select-option elist "" "Select Event")
|
||||
(dolist (event (getf info :events))
|
||||
(let ((attr (format nil "data-~A" (getf event :name))))
|
||||
(add-select-option elist
|
||||
(getf event :name)
|
||||
(format nil "~A ~A (panel ~A)"
|
||||
(if (has-attribute control attr)
|
||||
"■ "
|
||||
"□ ")
|
||||
(getf event :name)
|
||||
(getf event :parameters))
|
||||
:selected (equal attr current))))
|
||||
(set-on-change elist #'on-change))
|
||||
(on-blur (obj)
|
||||
(declare (ignore obj))
|
||||
(set-on-blur (event-editor app) nil)
|
||||
(let ((attr (attribute elist "data-current-event")))
|
||||
(unless (equalp attr "undefined")
|
||||
(let ((opt (select-text elist))
|
||||
(txt (text-value (event-editor app))))
|
||||
(setf (char opt 0) #\space)
|
||||
(setf opt (string-left-trim "#\space" opt))
|
||||
(cond ((or (equal txt "")
|
||||
(equalp txt "undefined"))
|
||||
(setf (select-text elist) (format nil "~A ~A" (code-char 9633) opt))
|
||||
(remove-attribute control attr))
|
||||
(t
|
||||
(setf (select-text elist) (format nil "~A ~A" (code-char 9632) opt))
|
||||
(setf (attribute control attr) txt))))
|
||||
(jquery-execute (get-placer control) "trigger('clog-builder-snap-shot')")))
|
||||
(set-on-blur (event-editor app) #'on-blur))
|
||||
(on-change (obj)
|
||||
(declare (ignore obj))
|
||||
(set-on-blur (event-editor app) nil)
|
||||
(let ((event (select-value elist "clog-events")))
|
||||
(cond ((equal event "")
|
||||
(set-on-blur (event-editor app) nil)
|
||||
(remove-attribute elist "data-current-event")
|
||||
(setf (text-value (event-editor app)) "")
|
||||
(setf (clog-ace:read-only-p (event-editor app)) t))
|
||||
(t
|
||||
(setf (clog-ace:read-only-p (event-editor app)) nil)
|
||||
(let* ((attr (format nil "data-~A" event))
|
||||
(txt (attribute control attr)))
|
||||
(setf (text-value (event-editor app))
|
||||
(if (equalp txt "undefined")
|
||||
""
|
||||
txt))
|
||||
(setf (attribute elist "data-current-event") attr)
|
||||
(set-on-blur (event-editor app) #'on-blur)))))))
|
||||
(populate-options))))))
|
||||
(on-populate-control-ps-events-win obj)
|
||||
(on-populate-control-js-events-win obj))
|
||||
(when obj
|
||||
(let* ((app (connection-data-item obj "builder-app-data"))
|
||||
(event-win (control-events-win app))
|
||||
(elist (events-list app))
|
||||
(control (current-control app)))
|
||||
(when event-win
|
||||
(set-on-blur (event-editor app) nil)
|
||||
(set-on-change elist nil)
|
||||
(setf (inner-html elist) "")
|
||||
(remove-attribute elist "data-current-event")
|
||||
(setf (text-value (event-editor app)) "")
|
||||
(setf (clog-ace:read-only-p (event-editor app)) t)
|
||||
(when control
|
||||
(let ((info (control-info (attribute control "data-clog-type"))))
|
||||
(labels ((populate-options (&key (current ""))
|
||||
(set-on-change elist nil)
|
||||
(setf (inner-html elist) "")
|
||||
(add-select-option elist "" "Select Event")
|
||||
(dolist (event (getf info :events))
|
||||
(let ((attr (format nil "data-~A" (getf event :name))))
|
||||
(add-select-option elist
|
||||
(getf event :name)
|
||||
(format nil "~A ~A (panel ~A)"
|
||||
(if (has-attribute control attr)
|
||||
"■ "
|
||||
"□ ")
|
||||
(getf event :name)
|
||||
(getf event :parameters))
|
||||
:selected (equal attr current))))
|
||||
(set-on-change elist #'on-change))
|
||||
(on-blur (obj)
|
||||
(declare (ignore obj))
|
||||
(set-on-blur (event-editor app) nil)
|
||||
(let ((attr (attribute elist "data-current-event")))
|
||||
(unless (equalp attr "undefined")
|
||||
(let ((opt (select-text elist))
|
||||
(txt (text-value (event-editor app))))
|
||||
(setf (char opt 0) #\space)
|
||||
(setf opt (string-left-trim "#\space" opt))
|
||||
(cond ((or (equal txt "")
|
||||
(equalp txt "undefined"))
|
||||
(setf (select-text elist) (format nil "~A ~A" (code-char 9633) opt))
|
||||
(remove-attribute control attr))
|
||||
(t
|
||||
(setf (select-text elist) (format nil "~A ~A" (code-char 9632) opt))
|
||||
(setf (attribute control attr) txt))))
|
||||
(jquery-execute (get-placer control) "trigger('clog-builder-snap-shot')")))
|
||||
(set-on-blur (event-editor app) #'on-blur))
|
||||
(on-change (obj)
|
||||
(declare (ignore obj))
|
||||
(set-on-blur (event-editor app) nil)
|
||||
(let ((event (select-value elist "clog-events")))
|
||||
(cond ((equal event "")
|
||||
(set-on-blur (event-editor app) nil)
|
||||
(remove-attribute elist "data-current-event")
|
||||
(setf (text-value (event-editor app)) "")
|
||||
(setf (clog-ace:read-only-p (event-editor app)) t))
|
||||
(t
|
||||
(setf (clog-ace:read-only-p (event-editor app)) nil)
|
||||
(let* ((attr (format nil "data-~A" event))
|
||||
(txt (attribute control attr)))
|
||||
(setf (text-value (event-editor app))
|
||||
(if (equalp txt "undefined")
|
||||
""
|
||||
txt))
|
||||
(setf (attribute elist "data-current-event") attr)
|
||||
(set-on-blur (event-editor app) #'on-blur)))))))
|
||||
(populate-options))))))
|
||||
(on-populate-control-ps-events-win obj)
|
||||
(on-populate-control-js-events-win obj)))
|
||||
|
||||
(defun on-populate-control-js-events-win (obj)
|
||||
"Populate the control js events for the current control"
|
||||
|
|
|
|||
|
|
@ -109,97 +109,100 @@
|
|||
(on-size win))))
|
||||
(window-focus (controls-win app))))
|
||||
|
||||
(defun on-populate-control-list-win (content &key win)
|
||||
(defun on-populate-control-list-win (content &key win clear)
|
||||
"Populate the control-list-window to allow drag and drop adjust of order
|
||||
of controls and double click to select control."
|
||||
(when content
|
||||
(with-sync-event (content)
|
||||
(let ((app (connection-data-item content "builder-app-data")))
|
||||
(let ((panel-id (html-id content))
|
||||
(last-ctl nil))
|
||||
(let ((app (connection-data-item content "builder-app-data")))
|
||||
(if clear
|
||||
(when (control-list-win app)
|
||||
(let ((lwin (control-list-win app)))
|
||||
(setf (inner-html lwin) "")
|
||||
(set-on-mouse-click (create-div lwin :content (attribute content "data-clog-name"))
|
||||
(lambda (obj data)
|
||||
(declare (ignore obj data))
|
||||
(deselect-current-control app)
|
||||
(on-populate-control-properties-win content :win win)
|
||||
(on-populate-control-list-win content :win win)))
|
||||
(labels ((add-siblings (control sim)
|
||||
(let (dln dcc)
|
||||
(loop
|
||||
(when (equal (html-id control) "undefined") (return))
|
||||
(setf dcc (attribute control "data-clog-composite-control"))
|
||||
(setf dln (attribute control "data-clog-name"))
|
||||
(unless (or (equal dln "undefined")
|
||||
(eq dln nil))
|
||||
(let ((list-item (create-div lwin :content (format nil "↕ ~A~A" sim dln)))
|
||||
(status (hiddenp (get-placer control))))
|
||||
(if status
|
||||
(setf (color list-item) :darkred)
|
||||
(setf (background-color list-item) :grey))
|
||||
(setf (draggablep list-item) t)
|
||||
(setf (attribute list-item "data-clog-control") (html-id control))
|
||||
;; click to select item
|
||||
(set-on-mouse-down list-item
|
||||
(lambda (obj data)
|
||||
(let* ((html-id (attribute obj "data-clog-control"))
|
||||
(control (get-from-control-list app
|
||||
panel-id
|
||||
html-id)))
|
||||
(cond ((or (getf data :shift-key)
|
||||
(getf data :ctrl-key)
|
||||
(getf data :meta-key))
|
||||
(when (drop-new-control app content data)
|
||||
(incf-next-id content)))
|
||||
(t
|
||||
(when last-ctl
|
||||
(set-border last-ctl "0px" :dotted :blue))
|
||||
(set-border list-item "2px" :dotted :blue)
|
||||
(setf last-ctl list-item)
|
||||
(select-control control))))))
|
||||
(set-on-double-click list-item
|
||||
(lambda (obj)
|
||||
(let* ((html-id (attribute obj "data-clog-control"))
|
||||
(control (get-from-control-list app
|
||||
panel-id
|
||||
html-id))
|
||||
(placer (get-placer control))
|
||||
(state (hiddenp placer)))
|
||||
(setf (hiddenp placer) (not state))
|
||||
(select-control control)
|
||||
(on-populate-control-list-win content :win win))))
|
||||
;; drag and drop to change
|
||||
(set-on-drag-over list-item (lambda (obj)(declare (ignore obj))()))
|
||||
(set-on-drop list-item
|
||||
(lambda (obj data)
|
||||
(let* ((id (attribute obj "data-clog-control"))
|
||||
(control1 (get-from-control-list app
|
||||
panel-id
|
||||
id))
|
||||
(control2 (get-from-control-list app
|
||||
panel-id
|
||||
(getf data :drag-data)))
|
||||
(placer1 (get-placer control1))
|
||||
(placer2 (get-placer control2)))
|
||||
(if (getf data :shift-key)
|
||||
(place-inside-bottom-of control1 control2)
|
||||
(place-before control1 control2))
|
||||
(place-after control2 placer2)
|
||||
(set-geometry placer1 :top (position-top control1)
|
||||
:left (position-left control1)
|
||||
:width (client-width control1)
|
||||
:height (client-height control1))
|
||||
(set-geometry placer2 :top (position-top control2)
|
||||
:left (position-left control2)
|
||||
:width (client-width control2)
|
||||
:height (client-height control2))
|
||||
(on-populate-control-properties-win content :win win)
|
||||
(on-populate-control-list-win content :win win))))
|
||||
(set-on-drag-start list-item (lambda (obj)(declare (ignore obj))())
|
||||
:drag-data (html-id control))
|
||||
(when (equal dcc "undefined") ; when t is not a composite control
|
||||
(add-siblings (first-child control) (format nil "~A→" sim)))))
|
||||
(setf control (next-sibling control))))))
|
||||
(add-siblings (first-child content) "")))))))))
|
||||
(setf (inner-html (control-list-win app)) ""))
|
||||
(with-sync-event (content)
|
||||
(let ((panel-id (html-id content))
|
||||
(last-ctl nil))
|
||||
(when (control-list-win app)
|
||||
(let ((lwin (control-list-win app)))
|
||||
(setf (inner-html lwin) "")
|
||||
(set-on-mouse-click (create-div lwin :content (attribute content "data-clog-name"))
|
||||
(lambda (obj data)
|
||||
(declare (ignore obj data))
|
||||
(deselect-current-control app)
|
||||
(on-populate-control-properties-win content :win win)
|
||||
(on-populate-control-list-win content :win win)))
|
||||
(labels ((add-siblings (control sim)
|
||||
(let (dln dcc)
|
||||
(loop
|
||||
(when (equal (html-id control) "undefined") (return))
|
||||
(setf dcc (attribute control "data-clog-composite-control"))
|
||||
(setf dln (attribute control "data-clog-name"))
|
||||
(unless (or (equal dln "undefined")
|
||||
(eq dln nil))
|
||||
(let ((list-item (create-div lwin :content (format nil "↕ ~A~A" sim dln)))
|
||||
(status (hiddenp (get-placer control))))
|
||||
(if status
|
||||
(setf (color list-item) :darkred)
|
||||
(setf (background-color list-item) :grey))
|
||||
(setf (draggablep list-item) t)
|
||||
(setf (attribute list-item "data-clog-control") (html-id control))
|
||||
;; click to select item
|
||||
(set-on-mouse-down list-item
|
||||
(lambda (obj data)
|
||||
(let* ((html-id (attribute obj "data-clog-control"))
|
||||
(control (get-from-control-list app
|
||||
panel-id
|
||||
html-id)))
|
||||
(cond ((or (getf data :shift-key)
|
||||
(getf data :ctrl-key)
|
||||
(getf data :meta-key))
|
||||
(when (drop-new-control app content data)
|
||||
(incf-next-id content)))
|
||||
(t
|
||||
(when last-ctl
|
||||
(set-border last-ctl "0px" :dotted :blue))
|
||||
(set-border list-item "2px" :dotted :blue)
|
||||
(setf last-ctl list-item)
|
||||
(select-control control))))))
|
||||
(set-on-double-click list-item
|
||||
(lambda (obj)
|
||||
(let* ((html-id (attribute obj "data-clog-control"))
|
||||
(control (get-from-control-list app
|
||||
panel-id
|
||||
html-id))
|
||||
(placer (get-placer control))
|
||||
(state (hiddenp placer)))
|
||||
(setf (hiddenp placer) (not state))
|
||||
(select-control control)
|
||||
(on-populate-control-list-win content :win win))))
|
||||
;; drag and drop to change
|
||||
(set-on-drag-over list-item (lambda (obj)(declare (ignore obj))()))
|
||||
(set-on-drop list-item
|
||||
(lambda (obj data)
|
||||
(let* ((id (attribute obj "data-clog-control"))
|
||||
(control1 (get-from-control-list app
|
||||
panel-id
|
||||
id))
|
||||
(control2 (get-from-control-list app
|
||||
panel-id
|
||||
(getf data :drag-data)))
|
||||
(placer1 (get-placer control1))
|
||||
(placer2 (get-placer control2)))
|
||||
(if (getf data :shift-key)
|
||||
(place-inside-bottom-of control1 control2)
|
||||
(place-before control1 control2))
|
||||
(place-after control2 placer2)
|
||||
(set-geometry placer1 :top (position-top control1)
|
||||
:left (position-left control1)
|
||||
:width (client-width control1)
|
||||
:height (client-height control1))
|
||||
(set-geometry placer2 :top (position-top control2)
|
||||
:left (position-left control2)
|
||||
:width (client-width control2)
|
||||
:height (client-height control2))
|
||||
(on-populate-control-properties-win content :win win)
|
||||
(on-populate-control-list-win content :win win))))
|
||||
(set-on-drag-start list-item (lambda (obj)(declare (ignore obj))())
|
||||
:drag-data (html-id control))
|
||||
(when (equal dcc "undefined") ; when t is not a composite control
|
||||
(add-siblings (first-child control) (format nil "~A→" sim)))))
|
||||
(setf control (next-sibling control))))))
|
||||
(add-siblings (first-child content) ""))))))))))
|
||||
|
|
|
|||
|
|
@ -22,129 +22,132 @@
|
|||
(set-geometry control-list :left 0 :top 0 :right 0)))
|
||||
(window-focus (control-properties-win app))))
|
||||
|
||||
(defun on-populate-control-properties-win (obj &key win)
|
||||
(defun on-populate-control-properties-win (obj &key win clear)
|
||||
"Populate the control properties for the current control"
|
||||
;; obj if current-control is nil must be content
|
||||
(with-sync-event (obj)
|
||||
(bordeaux-threads:make-thread (lambda () (on-populate-control-events-win obj)))
|
||||
(when obj
|
||||
(let ((app (connection-data-item obj "builder-app-data")))
|
||||
(let* ((prop-win (control-properties-win app))
|
||||
(control (if (current-control app)
|
||||
(current-control app)
|
||||
obj))
|
||||
(placer (when control
|
||||
(get-placer control)))
|
||||
(table (properties-list app)))
|
||||
(when prop-win
|
||||
(setf (inner-html table) "")
|
||||
(let ((info (control-info (attribute control "data-clog-type")))
|
||||
props)
|
||||
(dolist (prop (reverse (getf info :properties)))
|
||||
(cond ((eq (third prop) :style)
|
||||
(push `(,(getf prop :name) ,(style control (getf prop :style)) ,(getf prop :setup)
|
||||
,(lambda (obj)
|
||||
(setf (style control (getf prop :style)) (text obj))))
|
||||
props))
|
||||
((or (eq (third prop) :get)
|
||||
(eq (third prop) :set)
|
||||
(eq (third prop) :setup))
|
||||
(push `(,(getf prop :name) ,(when (getf prop :get)
|
||||
(funcall (getf prop :get) control))
|
||||
,(getf prop :setup)
|
||||
,(lambda (obj)
|
||||
(when (getf prop :set)
|
||||
(funcall (getf prop :set) control obj))))
|
||||
props))
|
||||
((eq (third prop) :prop)
|
||||
(push `(,(getf prop :name) ,(property control (getf prop :prop)) ,(getf prop :setup)
|
||||
,(lambda (obj)
|
||||
(setf (property control (getf prop :prop)) (text obj))))
|
||||
props))
|
||||
((eq (third prop) :attr)
|
||||
(push `(,(getf prop :name) ,(attribute control (getf prop :attr)) ,(getf prop :setup)
|
||||
,(lambda (obj)
|
||||
(setf (attribute control (getf prop :attr)) (text obj))))
|
||||
props))
|
||||
(t (print "Configuration error."))))
|
||||
(when (current-control app)
|
||||
(let* (panel-controls
|
||||
(cname (attribute control "data-clog-name"))
|
||||
(ctype (attribute control "data-clog-type"))
|
||||
(panel-id (attribute placer "data-panel-id"))
|
||||
(panel (attach-as-child obj panel-id)))
|
||||
(maphash (lambda (k v)
|
||||
(declare (ignore k))
|
||||
(let ((n (attribute v "data-clog-name"))
|
||||
(p (attribute (parent-element v) "data-clog-name")))
|
||||
(unless (or (equal cname n)
|
||||
(equal cname p))
|
||||
(push n panel-controls))))
|
||||
(get-control-list app panel-id))
|
||||
(push (attribute panel "data-clog-name") panel-controls)
|
||||
(push
|
||||
`("parent" nil
|
||||
,(lambda (control td1 td2)
|
||||
(declare (ignore td1))
|
||||
(let ((dd (create-select td2))
|
||||
(v (attribute (parent-element control) "data-clog-name")))
|
||||
(set-geometry dd :width "100%")
|
||||
(add-select-options dd panel-controls)
|
||||
(setf (value dd) v)
|
||||
(set-on-change dd
|
||||
(lambda (obj)
|
||||
(place-inside-bottom-of
|
||||
(attach-as-child control
|
||||
(js-query
|
||||
control
|
||||
(format nil "$(\"[data-clog-name='~A']\").attr('id')"
|
||||
(value obj))))
|
||||
control)
|
||||
(place-after control placer)
|
||||
(on-populate-control-list-win panel :win win))))
|
||||
nil)
|
||||
nil)
|
||||
props)
|
||||
(push
|
||||
`("type" ,ctype
|
||||
:read-only
|
||||
nil
|
||||
nil)
|
||||
props)
|
||||
(push
|
||||
`("name" ,cname
|
||||
nil
|
||||
,(lambda (obj)
|
||||
(let ((vname (text obj)))
|
||||
(unless (equal vname "")
|
||||
(when (equal (subseq vname 0 1) "(")
|
||||
(setf vname (format nil "|~A|" vname)))
|
||||
(setf (attribute control "data-clog-name") vname)
|
||||
(when (equal (getf info :name) "clog-data")
|
||||
(when win
|
||||
(setf (window-title win) vname)))))))
|
||||
props)))
|
||||
(dolist (item props)
|
||||
(let* ((tr (create-table-row table))
|
||||
(td1 (create-table-column tr :content (first item)))
|
||||
(td2 (if (second item)
|
||||
(create-table-column tr :content (second item))
|
||||
(create-table-column tr))))
|
||||
(setf (width td1) "30%")
|
||||
(setf (width td2) "70%")
|
||||
(setf (spellcheckp td2) nil)
|
||||
(set-border td1 "1px" :dotted :black)
|
||||
(cond ((third item)
|
||||
(unless (eq (third item) :read-only)
|
||||
(setf (editablep td2) (funcall (third item) control td1 td2))))
|
||||
(t
|
||||
(setf (editablep td2) t)))
|
||||
(when (fourth item)
|
||||
(set-on-blur td2
|
||||
(lambda (obj)
|
||||
(funcall (fourth item) obj)
|
||||
(when placer
|
||||
(jquery-execute placer "trigger('clog-builder-snap-shot')")
|
||||
(set-geometry placer :top (position-top control)
|
||||
:left (position-left control)
|
||||
:width (client-width control)
|
||||
:height (client-height control))))))))))))))
|
||||
(if clear
|
||||
(setf (inner-html (properties-list app)) "")
|
||||
(with-sync-event (obj)
|
||||
(bordeaux-threads:make-thread (lambda () (on-populate-control-events-win obj)))
|
||||
(let* ((prop-win (control-properties-win app))
|
||||
(control (if (current-control app)
|
||||
(current-control app)
|
||||
obj))
|
||||
(placer (when control
|
||||
(get-placer control)))
|
||||
(table (properties-list app)))
|
||||
(when prop-win
|
||||
(setf (inner-html table) "")
|
||||
(let ((info (control-info (attribute control "data-clog-type")))
|
||||
props)
|
||||
(dolist (prop (reverse (getf info :properties)))
|
||||
(cond ((eq (third prop) :style)
|
||||
(push `(,(getf prop :name) ,(style control (getf prop :style)) ,(getf prop :setup)
|
||||
,(lambda (obj)
|
||||
(setf (style control (getf prop :style)) (text obj))))
|
||||
props))
|
||||
((or (eq (third prop) :get)
|
||||
(eq (third prop) :set)
|
||||
(eq (third prop) :setup))
|
||||
(push `(,(getf prop :name) ,(when (getf prop :get)
|
||||
(funcall (getf prop :get) control))
|
||||
,(getf prop :setup)
|
||||
,(lambda (obj)
|
||||
(when (getf prop :set)
|
||||
(funcall (getf prop :set) control obj))))
|
||||
props))
|
||||
((eq (third prop) :prop)
|
||||
(push `(,(getf prop :name) ,(property control (getf prop :prop)) ,(getf prop :setup)
|
||||
,(lambda (obj)
|
||||
(setf (property control (getf prop :prop)) (text obj))))
|
||||
props))
|
||||
((eq (third prop) :attr)
|
||||
(push `(,(getf prop :name) ,(attribute control (getf prop :attr)) ,(getf prop :setup)
|
||||
,(lambda (obj)
|
||||
(setf (attribute control (getf prop :attr)) (text obj))))
|
||||
props))
|
||||
(t (print "Configuration error."))))
|
||||
(when (current-control app)
|
||||
(let* (panel-controls
|
||||
(cname (attribute control "data-clog-name"))
|
||||
(ctype (attribute control "data-clog-type"))
|
||||
(panel-id (attribute placer "data-panel-id"))
|
||||
(panel (attach-as-child obj panel-id)))
|
||||
(maphash (lambda (k v)
|
||||
(declare (ignore k))
|
||||
(let ((n (attribute v "data-clog-name"))
|
||||
(p (attribute (parent-element v) "data-clog-name")))
|
||||
(unless (or (equal cname n)
|
||||
(equal cname p))
|
||||
(push n panel-controls))))
|
||||
(get-control-list app panel-id))
|
||||
(push (attribute panel "data-clog-name") panel-controls)
|
||||
(push
|
||||
`("parent" nil
|
||||
,(lambda (control td1 td2)
|
||||
(declare (ignore td1))
|
||||
(let ((dd (create-select td2))
|
||||
(v (attribute (parent-element control) "data-clog-name")))
|
||||
(set-geometry dd :width "100%")
|
||||
(add-select-options dd panel-controls)
|
||||
(setf (value dd) v)
|
||||
(set-on-change dd
|
||||
(lambda (obj)
|
||||
(place-inside-bottom-of
|
||||
(attach-as-child control
|
||||
(js-query
|
||||
control
|
||||
(format nil "$(\"[data-clog-name='~A']\").attr('id')"
|
||||
(value obj))))
|
||||
control)
|
||||
(place-after control placer)
|
||||
(on-populate-control-list-win panel :win win))))
|
||||
nil)
|
||||
nil)
|
||||
props)
|
||||
(push
|
||||
`("type" ,ctype
|
||||
:read-only
|
||||
nil
|
||||
nil)
|
||||
props)
|
||||
(push
|
||||
`("name" ,cname
|
||||
nil
|
||||
,(lambda (obj)
|
||||
(let ((vname (text obj)))
|
||||
(unless (equal vname "")
|
||||
(when (equal (subseq vname 0 1) "(")
|
||||
(setf vname (format nil "|~A|" vname)))
|
||||
(setf (attribute control "data-clog-name") vname)
|
||||
(when (equal (getf info :name) "clog-data")
|
||||
(when win
|
||||
(setf (window-title win) vname)))))))
|
||||
props)))
|
||||
(dolist (item props)
|
||||
(let* ((tr (create-table-row table))
|
||||
(td1 (create-table-column tr :content (first item)))
|
||||
(td2 (if (second item)
|
||||
(create-table-column tr :content (second item))
|
||||
(create-table-column tr))))
|
||||
(setf (width td1) "30%")
|
||||
(setf (width td2) "70%")
|
||||
(setf (spellcheckp td2) nil)
|
||||
(set-border td1 "1px" :dotted :black)
|
||||
(cond ((third item)
|
||||
(unless (eq (third item) :read-only)
|
||||
(setf (editablep td2) (funcall (third item) control td1 td2))))
|
||||
(t
|
||||
(setf (editablep td2) t)))
|
||||
(when (fourth item)
|
||||
(set-on-blur td2
|
||||
(lambda (obj)
|
||||
(funcall (fourth item) obj)
|
||||
(when placer
|
||||
(jquery-execute placer "trigger('clog-builder-snap-shot')")
|
||||
(set-geometry placer :top (position-top control)
|
||||
:left (position-left control)
|
||||
:width (client-width control)
|
||||
:height (client-height control))))))))))))))))
|
||||
|
|
|
|||
|
|
@ -481,11 +481,13 @@ not a temporarily attached one when using select-control."
|
|||
|
||||
;; Panel Windows
|
||||
|
||||
(defun on-new-builder-panel-ext (obj &key open-file popup)
|
||||
(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"
|
||||
open-file)
|
||||
(format nil "/panel-editor?open-panel=~A~A"
|
||||
open-file (if open-ext
|
||||
(format nil "&open-ext=~A" open-ext)
|
||||
""))
|
||||
"/source-editor")
|
||||
:specs (if (or popup *open-external-panels-in-popup*)
|
||||
"width=1280,height=700"
|
||||
|
|
@ -589,9 +591,10 @@ not a temporarily attached one when using select-control."
|
|||
(multiple-value-bind (pop pop-win)
|
||||
(open-clog-popup obj :specs "width=640,height=480")
|
||||
(when pop
|
||||
(create-div content :content "Panel is external. Click to bring to front.")
|
||||
(set-on-click content
|
||||
(lambda (obj) (focus pop-win)))
|
||||
(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) (focus pop-win))))
|
||||
(setf ext-panel pop)
|
||||
(cond ((eq open-ext :custom)
|
||||
(load-css (html-document pop) "/css/jquery-ui.css")
|
||||
|
|
@ -613,9 +616,13 @@ not a temporarily attached one when using select-control."
|
|||
(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)))
|
||||
(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" "./"
|
||||
|
|
@ -649,23 +656,21 @@ not a temporarily attached one when using select-control."
|
|||
(on-show-control-events-win win)
|
||||
(on-show-control-properties-win win)
|
||||
(on-show-control-list-win win)
|
||||
(panel-mode win t)
|
||||
(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))
|
||||
(panel-mode win t)
|
||||
(on-populate-control-properties-win content :win win)
|
||||
(on-populate-control-list-win content :win win)))
|
||||
(set-on-window-blur win
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(panel-mode win nil)))
|
||||
(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
|
||||
|
|
|
|||
|
|
@ -29,6 +29,8 @@
|
|||
(let* ((app (connection-data-item panel "builder-app-data")))
|
||||
(when *open-external*
|
||||
(setf (checkedp (open-ext panel)) t))
|
||||
(when *open-panels-as-popups*
|
||||
(setf (checkedp (pop-panel panel)) t))
|
||||
(when (uiop:directory-exists-p #P"~/common-lisp/")
|
||||
(pushnew #P"~/common-lisp/"
|
||||
(symbol-value (read-from-string "ql:*local-project-directories*"))
|
||||
|
|
@ -367,8 +369,8 @@
|
|||
((and (> (length item) 5)
|
||||
(equal (subseq item (- (length item) 5)) ".clog"))
|
||||
(if (checkedp (open-ext panel))
|
||||
(on-new-builder-panel-ext target :open-file item)
|
||||
(on-new-builder-panel target :open-file item)))
|
||||
(on-new-builder-panel-ext target :open-file item :open-ext (checkedp (pop-panel panel)))
|
||||
(on-new-builder-panel target :open-file item :open-ext (checkedp (pop-panel panel)))))
|
||||
(t
|
||||
(if (checkedp (open-ext panel))
|
||||
(on-open-file-ext target :open-file item)
|
||||
|
|
|
|||
|
|
@ -100,14 +100,6 @@ clog-builder window.")
|
|||
:accessor project-win
|
||||
:initform nil
|
||||
:documentation "Project window")
|
||||
(right-panel
|
||||
:accessor right-panel
|
||||
:initform nil
|
||||
:documentation "Right panel")
|
||||
(left-panel
|
||||
:accessor left-panel
|
||||
:initform nil
|
||||
:documentation "Left panel")
|
||||
(control-properties-win
|
||||
:accessor control-properties-win
|
||||
:initform nil
|
||||
|
|
@ -196,15 +188,6 @@ clog-builder window.")
|
|||
(setf (hiddenp win) t)
|
||||
nil))))))
|
||||
|
||||
(defun panel-mode (obj bool)
|
||||
"Set the status for display or hiding the side panels."
|
||||
(when obj
|
||||
(let ((app (connection-data-item obj "builder-app-data")))
|
||||
(when (right-panel app)
|
||||
(setf (hiddenp (right-panel app)) (not bool)))
|
||||
(when (left-panel app)
|
||||
(setf (hiddenp (left-panel app)) (not bool))))))
|
||||
|
||||
(defun on-help-about-builder (obj)
|
||||
"Open about box"
|
||||
(let ((about (create-gui-window obj
|
||||
|
|
@ -342,7 +325,8 @@ clog-builder window.")
|
|||
(set-html-on-close body "Connection Lost")
|
||||
(let ((app (make-instance 'builder-app-data))
|
||||
(open-file (form-data-item (form-get-data body) "open-file"))
|
||||
(open-panel (form-data-item (form-get-data body) "open-panel")))
|
||||
(open-panel (form-data-item (form-get-data body) "open-panel"))
|
||||
(open-ext (form-data-item (form-get-data body) "open-ext")))
|
||||
(setf (connection-data-item body "builder-app-data") app)
|
||||
(setf (title (html-document body)) "CLOG Builder")
|
||||
(clog-gui-initialize body)
|
||||
|
|
@ -435,7 +419,7 @@ clog-builder window.")
|
|||
(cond
|
||||
(open-panel
|
||||
(setf (title (html-document body)) open-panel)
|
||||
(on-new-builder-panel body :open-file open-panel))
|
||||
(on-new-builder-panel body :open-file open-panel :open-ext open-ext))
|
||||
(open-file
|
||||
(setf (title (html-document body)) open-file)
|
||||
(on-open-file body :open-file open-file :maximized t))
|
||||
|
|
|
|||
6
tools/panel-projects.clog
vendored
6
tools/panel-projects.clog
vendored
|
|
@ -1,4 +1,4 @@
|
|||
<data id="I3918817107" data-in-package="clog-tools" data-custom-slots="" data-clog-next-id="47" data-clog-title="projects"></data><label for="undefined" data-clog-type="label" data-clog-for="projects-list" data-clog-name="projects-label" style="box-sizing: content-box; position: absolute; left: 5px; top: 6.99858px;">Current Project</label><select data-clog-type="dropdown" data-clog-name="project-list" style="box-sizing: content-box; position: absolute; left: 5px; top: 35px; width: 386.54px; height: 22px; bottom: 309.041px;" data-on-create="(projects-setup panel)" data-on-change="(projects-populate panel)"></select><button data-clog-type="button" data-clog-name="edit-asd" style="box-sizing: content-box; position: absolute; left: 400px; top: 32px; height: 22px; width: 90px;" data-on-click="(let ((sel (text-value (project-list panel))))
|
||||
<data id="I3920248400" data-in-package="clog-tools" data-custom-slots="" data-clog-next-id="49" data-clog-title="projects"></data><label for="undefined" data-clog-type="label" data-clog-for="projects-list" data-clog-name="projects-label" style="box-sizing: content-box; position: absolute; left: 5px; top: 6.99858px;">Current Project</label><select data-clog-type="dropdown" data-clog-name="project-list" style="box-sizing: content-box; position: absolute; left: 5px; top: 35px; width: 386.54px; height: 22px; bottom: 309.041px;" data-on-create="(projects-setup panel)" data-on-change="(projects-populate panel)"></select><button data-clog-type="button" data-clog-name="edit-asd" style="box-sizing: content-box; position: absolute; left: 400px; top: 32px; height: 22px; width: 90px;" data-on-click="(let ((sel (text-value (project-list panel))))
|
||||
(on-open-file panel :open-file (asdf:system-source-file
|
||||
(asdf:find-system sel))))" title="Manualy projects .asd file">Edit .asd</button><label for="CLOGB386871257741" data-clog-type="label" data-clog-for="entry-point" data-clog-name="entry-point-label" style="box-sizing: content-box; position: absolute; left: 5px; top: 69px;">Entry Point - package:function</label><input type="TEXT" value="" data-clog-type="input" data-clog-name="entry-point" style="box-sizing: content-box; position: absolute; left: 5px; top: 94px; width: 381px; height: 22.5px;" data-on-change="(projects-entry-point-change panel)"><button data-clog-type="button" data-clog-name="run-button" style="box-sizing: content-box; position: absolute; left: 400px; top: 92px; width: 90px; height: 22.5px;" data-on-click="(projects-run panel)">Run</button><button data-clog-type="button" data-clog-name="new-project-button" style="box-sizing: content-box; position: absolute; left: 520px; top: 8px; width: 100px; height: 22px;" data-on-click="(on-new-app-template panel)" title="Create new project from template">New</button><button data-clog-type="button" data-clog-name="unload-project-button" style="box-sizing: content-box; position: absolute; left: 520px; top: 43px; width: 100px; height: 22px; bottom: 309.041px;" data-on-click="(let ((sel (text-value (project-list panel))))
|
||||
(unless (equal sel "None")
|
||||
|
|
@ -17,7 +17,7 @@
|
|||
(projects-add-dep panel sys))">Add</button><button data-clog-type="button" data-clog-name="runtime-del-dep" style="box-sizing: content-box; position: absolute; left: 95px; top: 480px; width: 65px; height: 22px;" data-on-click="(let ((sys (text-value (project-list panel)))
|
||||
(file (select-text (runtime-deps panel))))
|
||||
(remove-dep-from-defsystem sys file)
|
||||
(projects-populate panel))">Remove</button><label for="CLOGB3868393704" data-clog-type="label" data-clog-for="designtime-list" data-clog-name="designtime-label" style="box-sizing: content-box; position: absolute; left: 290.007px; top: 65px;">Design Time System (/tools)</label><select data-clog-type="listbox" size="4" data-clog-name="designtime-list" style="box-sizing: content-box; position: absolute; left: 290px; top: 115px; width: 265px; height: 195.545px;" data-on-double-click="(open-projects-component target panel
|
||||
(projects-populate panel))">Remove</button><label for="CLOGB3868393704" data-clog-type="label" data-clog-for="designtime-list" data-clog-name="designtime-label" style="box-sizing: content-box; position: absolute; left: 290px; top: 65px;">Design Time System (/tools)</label><select data-clog-type="listbox" size="4" data-clog-name="designtime-list" style="box-sizing: content-box; position: absolute; left: 290px; top: 115px; width: 265px; height: 195.545px;" data-on-double-click="(open-projects-component target panel
|
||||
(format nil "~A/tools" (text-value (project-list panel))) target)"></select><button data-clog-type="button" data-clog-name="designtime-add-clog" style="box-sizing: content-box; position: absolute; left: 290px; top: 320px;" data-on-click="(let ((sys (text-value (project-list panel))))
|
||||
(projects-add-clog panel sys))
|
||||
">Add .clog</button><button data-clog-type="button" data-clog-name="designtime-add-lisp" style="box-sizing: content-box; position: absolute; left: 386px; top: 320px;" data-on-click="(let ((sys (format nil "~A/tools" (text-value (project-list panel)))))
|
||||
|
|
@ -37,4 +37,4 @@
|
|||
(projects-populate panel))">Remove</button><button data-clog-type="button" data-clog-name="design-plugin" style="box-sizing: content-box; position: absolute; left: 470px; top: 480px; width: 65px; height: 22px;" data-on-click="(let ((sys (text-value (project-list panel))))
|
||||
(projects-add-plugin panel sys))
|
||||
">Plugin</button></div>
|
||||
<label for="CLOGB391881683346" data-clog-type="label" data-clog-for="open-ext" data-clog-name="ext-win-label" style="box-sizing: content-box; position: absolute; left: 531px; top: 151px;" class="">Open External</label><input type="CHECKBOX" value="" data-clog-type="checkbox" data-clog-name="open-ext" style="box-sizing: content-box; position: absolute; left: 513px; top: 155px;">
|
||||
<label for="CLOGB391881683346" data-clog-type="label" data-clog-for="open-ext" data-clog-name="ext-win-label" style="box-sizing: content-box; position: absolute; left: 531px; top: 144px;" class="">open external</label><input type="CHECKBOX" value="" data-clog-type="checkbox" data-clog-name="open-ext" style="box-sizing: content-box; position: absolute; left: 513px; top: 150px;"><input type="CHECKBOX" value="" data-clog-type="checkbox" data-clog-name="pop-panel" style="box-sizing: content-box; position: absolute; left: 513px; top: 167px;"><label for="undefined" data-clog-type="label" data-clog-for="pop-panel" data-clog-name="pop-panel-label" style="box-sizing: content-box; position: absolute; left: 531px; top: 161px;">popup panels</label>
|
||||
File diff suppressed because one or more lines are too long
Loading…
Add table
Add a link
Reference in a new issue