mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-27 04:11:51 -08:00
Support for new controls with embedded controls
This commit is contained in:
David Botton
parent
8cfa2e8571
commit
b796f79930
4 changed files with 145 additions and 69 deletions
|
|
@ -253,3 +253,55 @@ if :HTML-ID \"myid\" then the HTML-ID for center will be: myid-center"
|
|||
:units units
|
||||
:html-id (format nil "~A-bottom" html-id)))
|
||||
panel-box))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Implementation - clog-panel-box
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defclass clog-panel-box (clog-element)
|
||||
((panel-box
|
||||
:accessor panel-box
|
||||
:documentation "CLOG-PANEL-BOX-LAYOUT access"))
|
||||
(:documentation "CLOG Panel-Box Objects."))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; create-panel-box ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric create-panel-box (clog-obj &key hidden class html-id auto-place)
|
||||
(:documentation "Create a new CLOG-Panel-Box, a div containg a
|
||||
CLOG-PANEL-BOX-LAYOUT as child of CLOG-OBJ with and if :AUTO-PLACE
|
||||
(default t) place-inside-bottom-of CLOG-OBJ. If hidden is true visiblep
|
||||
is set to nil."))
|
||||
|
||||
(defmethod create-panel-box ((obj clog-obj) &key (content "")
|
||||
(width "100%") (height "100%")
|
||||
(hidden nil)
|
||||
(class nil)
|
||||
(html-id nil)
|
||||
(auto-place t))
|
||||
(let ((parent (create-child obj (format nil "<div~A~A~A~A/>"
|
||||
(if class
|
||||
(format nil " class='~A'" (escape-string class))
|
||||
"")
|
||||
(if width
|
||||
(format nil " width='~A'" width)
|
||||
"")
|
||||
(if height
|
||||
(format nil " height='~A'" height)
|
||||
"")
|
||||
(if hidden
|
||||
" style='visibility:hidden;'"
|
||||
""))
|
||||
:clog-type 'clog-panel-box
|
||||
:html-id html-id
|
||||
:auto-place auto-place)))
|
||||
(setf (panel-box parent) (create-panel-box-layout parent :html-id (html-id parent)))
|
||||
parent))
|
||||
|
||||
;;;;;;;;;;;;;;;
|
||||
;; panel-box ;;
|
||||
;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric panel-box (clog-panel-box)
|
||||
(:documentation "Returns the CLOG-PANEL-BOX-LAYOUT object contained in the CLOG-PANEL-BOX."))
|
||||
|
|
|
|||
|
|
@ -474,6 +474,11 @@ embedded in a native template application.)"
|
|||
(clog-panel class)
|
||||
(create-panel generic-function)
|
||||
|
||||
"CLOG-Panel-Box - CLOG Panel Box"
|
||||
(clog-panel-box class)
|
||||
(create-panel-box generic-function)
|
||||
(panel-box generic-function)
|
||||
|
||||
"CLOG-Panel-Box-Layout"
|
||||
(clog-panel-box-layout class)
|
||||
(center-children generic-function)
|
||||
|
|
|
|||
|
|
@ -243,17 +243,15 @@
|
|||
`((:name "contents"
|
||||
:setup ,(lambda (control td1 td2)
|
||||
(declare (ignore td1))
|
||||
(let ((d1 (create-form-element td2 :text :value (inner-html control))))
|
||||
(let ((d1 (create-text-area td2 :value (inner-html control))))
|
||||
(set-on-change d1 (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(setf (inner-html control) (value d1)))))
|
||||
nil))
|
||||
))
|
||||
nil))))
|
||||
|
||||
(defparameter *props-css*
|
||||
`((:name "css classes"
|
||||
:prop "className")
|
||||
))
|
||||
:prop "className")))
|
||||
|
||||
(defparameter *props-base*
|
||||
`((:name "hidden"
|
||||
|
|
@ -292,8 +290,7 @@
|
|||
(:name "maximum width"
|
||||
:style "max-width")
|
||||
(:name "maximum height"
|
||||
:style "max-height")
|
||||
))
|
||||
:style "max-height")))
|
||||
|
||||
(defparameter *props-nav*
|
||||
'((:name "access key"
|
||||
|
|
@ -303,8 +300,15 @@
|
|||
(:name "tab index"
|
||||
:prop "tabindex")
|
||||
(:name "z index"
|
||||
:style "z-index")
|
||||
))
|
||||
:style "z-index")))
|
||||
|
||||
(defparameter *props-base*
|
||||
`(,@*props-location*
|
||||
,@*props-with-height*
|
||||
,@*props-css*
|
||||
,@*props-colors*
|
||||
,@*props-base*
|
||||
,@*props-nav*))
|
||||
|
||||
(defparameter *props-element*
|
||||
`(,@*props-location*
|
||||
|
|
@ -359,7 +363,15 @@
|
|||
:create clog:create-label
|
||||
:create-type :element
|
||||
:create-content "Label"
|
||||
:properties (,@*props-element*))
|
||||
:properties ((:name "for"
|
||||
:get ,(lambda (control)
|
||||
(clog::js-query control (format nil "$('#~A').attr('data-clog-name')"
|
||||
(attribute control "for"))))
|
||||
:set ,(lambda (control obj)
|
||||
(setf (attribute control "for")
|
||||
(clog::js-query control (format nil "$(\"[data-clog-name='~A']\").attr('id')"
|
||||
(text obj))))))
|
||||
,@*props-element*))
|
||||
`(:name "button"
|
||||
:description "Button"
|
||||
:clog-type clog:clog-button
|
||||
|
|
@ -383,15 +395,15 @@
|
|||
:clog-type clog:clog-img
|
||||
:create clog:create-img
|
||||
:create-type :base
|
||||
:setup ,(lambda (control control-record)
|
||||
(declare (ignore control-record))
|
||||
:setup ,(lambda (control content control-record)
|
||||
(declare (ignore content) (ignore control-record))
|
||||
(setf (url-src control) "/img/clogicon.png")
|
||||
(setf (alt-text control) "Add image url"))
|
||||
:properties ((:name "image url"
|
||||
:prop "src")
|
||||
(:name "alternative text"
|
||||
:prop "alt")
|
||||
,@*props-element*))
|
||||
,@*props-base*))
|
||||
`(:name "meter"
|
||||
:description "Meter"
|
||||
:clog-type clog:clog-meter
|
||||
|
|
@ -409,7 +421,7 @@
|
|||
:prop "min")
|
||||
(:name "optimum"
|
||||
:prop "optimum")
|
||||
,@*props-element*))
|
||||
,@*props-base*))
|
||||
`(:name "progress"
|
||||
:description "Progress Bar"
|
||||
:clog-type clog:clog-progress-bar
|
||||
|
|
@ -419,7 +431,7 @@
|
|||
:prop "value")
|
||||
(:name "maximum"
|
||||
:prop "max")
|
||||
,@*props-element*))
|
||||
,@*props-base*))
|
||||
`(:name "ol"
|
||||
:description "Ordered List"
|
||||
:clog-type clog:clog-ordered-list
|
||||
|
|
@ -449,13 +461,13 @@
|
|||
:clog-type clog:clog-table
|
||||
:create clog:create-table
|
||||
:create-type :base
|
||||
:properties (,@*props-element*))
|
||||
:properties (,@*props-base*))
|
||||
`(:name "tr"
|
||||
:description "Table Row"
|
||||
:clog-type clog:clog-table-row
|
||||
:create clog:create-table-row
|
||||
:create-type :base
|
||||
:properties (,@*props-element*))
|
||||
:properties (,@*props-base*))
|
||||
`(:name "td"
|
||||
:description "Table Column"
|
||||
:clog-type clog:clog-table-column
|
||||
|
|
@ -489,7 +501,7 @@
|
|||
:create-type :base
|
||||
:properties ((:name "span"
|
||||
:attr "span")
|
||||
,@*props-element*))
|
||||
,@*props-base*))
|
||||
`(:name "tcol"
|
||||
:description "Table Column Group Item"
|
||||
:clog-type clog:clog-table-column-group-item
|
||||
|
|
@ -498,25 +510,25 @@
|
|||
:create-content "Column Group Item"
|
||||
:properties ((:name "span"
|
||||
:attr "span")
|
||||
,@*props-element*))
|
||||
,@*props-base*))
|
||||
`(:name "thead"
|
||||
:description "Table Head"
|
||||
:clog-type clog:clog-table-head
|
||||
:create clog:create-table-head
|
||||
:create-type :base
|
||||
:properties (,@*props-element*))
|
||||
:properties (,@*props-base*))
|
||||
`(:name "tbody"
|
||||
:description "Table Body"
|
||||
:clog-type clog:clog-table-body
|
||||
:create clog:create-table-body
|
||||
:create-type :base
|
||||
:properties (,@*props-element*))
|
||||
:properties (,@*props-base*))
|
||||
`(:name "tfoot"
|
||||
:description "Table Footer"
|
||||
:clog-type clog:clog-table-footer
|
||||
:create clog:create-table-footer
|
||||
:create-type :base
|
||||
:properties (,@*props-element*))
|
||||
:properties (,@*props-base*))
|
||||
`(:name "tcaption"
|
||||
:description "Table Caption"
|
||||
:clog-type clog:clog-table-caption
|
||||
|
|
@ -711,7 +723,8 @@
|
|||
:create clog:create-form-element
|
||||
:create-type :form
|
||||
:create-param :url
|
||||
:create-value "" :properties (,@*props-form-element*))
|
||||
:create-value ""
|
||||
:properties (,@*props-form-element*))
|
||||
`(:name "week"
|
||||
:description "Form Week Input"
|
||||
:clog-type clog:clog-form-element
|
||||
|
|
@ -753,7 +766,7 @@
|
|||
:prop "muted")
|
||||
(:name "loop"
|
||||
:prop "loop")
|
||||
,@*props-element*))
|
||||
,@*props-base*))
|
||||
`(:name "video"
|
||||
:description "Video Player"
|
||||
:clog-type clog:clog-video
|
||||
|
|
@ -773,10 +786,10 @@
|
|||
:prop "muted")
|
||||
(:name "loop"
|
||||
:prop "loop")
|
||||
,@*props-element*))
|
||||
,@*props-base*))
|
||||
`(:name "canvas"
|
||||
:description "Canvas"
|
||||
:clog-type clog:clog-canvas
|
||||
:create clog:create-canvas
|
||||
:create-type :base
|
||||
:properties (,@*props-element*))))
|
||||
:properties (,@*props-base*))))
|
||||
|
|
|
|||
|
|
@ -106,7 +106,7 @@
|
|||
"Return control informaton record for CONTROL-TYPE-NAME from the *supported-controls* list."
|
||||
(find-if (lambda (x) (equal (getf x :name) control-type-name)) *supported-controls*))
|
||||
|
||||
(defun create-control (parent control-record uid)
|
||||
(defun create-control (parent content control-record uid)
|
||||
"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))
|
||||
|
|
@ -126,7 +126,7 @@
|
|||
(when control
|
||||
(setf (attribute control "data-clog-type") control-type-name)
|
||||
(when (getf control-record :setup)
|
||||
(funcall (getf control-record :setup) control control-record)))
|
||||
(funcall (getf control-record :setup) control content control-record)))
|
||||
control))
|
||||
|
||||
(defun drop-new-control (app content data next-id &key win)
|
||||
|
|
@ -145,6 +145,7 @@
|
|||
(control (create-control (if parent
|
||||
parent
|
||||
content)
|
||||
content
|
||||
control-record
|
||||
(format nil "B~A~A"
|
||||
(get-universal-time)
|
||||
|
|
@ -248,6 +249,47 @@ not a temporary attached one when using select-control."
|
|||
(set-border placer (unit "px" 2) :solid :blue)
|
||||
(on-populate-control-properties-win control)))
|
||||
|
||||
(defun add-sub-controls (parent content &key win)
|
||||
"Setup html imported in to CONTENT starting with PARENT for use with Builder"
|
||||
(let ((app (connection-data-item content "builder-app-data"))
|
||||
(panel-uid (get-universal-time))
|
||||
(panel-id (html-id content)))
|
||||
;; 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','A'+clog_id++);~
|
||||
e.attr('data-clog-name','none-'+t+'-'+clog_nid++)}~
|
||||
if(e.attr('data-clog-name') === undefined){e.attr('data-clog-name',e.attr('id'))}~
|
||||
~{~A~}~
|
||||
if(e.attr('data-clog-type') === undefined){e.attr('data-clog-type','span')}})"
|
||||
panel-uid
|
||||
(clog::jquery parent)
|
||||
(mapcar (lambda (l)
|
||||
(format nil "if(p === undefined && t=='~A'){e.attr('data-clog-type','~A')}"
|
||||
(getf l :tag) (getf l :control)))
|
||||
*import-types*))))
|
||||
(clog::js-execute parent tmp))
|
||||
(let* ((data (first-child parent))
|
||||
(name (attribute data "data-clog-title")))
|
||||
(when name
|
||||
(unless (equalp name "undefined")
|
||||
(setf (attribute parent "data-clog-name") name)
|
||||
(destroy data))))
|
||||
(labels ((add-siblings (control)
|
||||
(let (dct)
|
||||
(loop
|
||||
(when (equal (html-id control) "undefined") (return))
|
||||
(setf dct (attribute control "data-clog-type"))
|
||||
(unless (equal dct "undefined")
|
||||
(change-class control (getf (control-info dct) :clog-type))
|
||||
(setup-control content control :win win)
|
||||
(add-siblings (first-child control)))
|
||||
(setf control (next-sibling control))))))
|
||||
(add-siblings (first-child parent)))))
|
||||
|
||||
;; Population of utility windows
|
||||
|
||||
(defun on-populate-control-properties-win (obj)
|
||||
|
|
@ -332,45 +374,7 @@ not a temporary attached one when using select-control."
|
|||
|
||||
(defun on-populate-loaded-window (content &key win)
|
||||
"Setup html imported in to CONTENT for use with Builder"
|
||||
(let ((app (connection-data-item content "builder-app-data"))
|
||||
(panel-uid (get-universal-time))
|
||||
(panel-id (html-id content)))
|
||||
(clrhash (get-control-list app panel-id))
|
||||
;; 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','A'+clog_id++);~
|
||||
e.attr('data-clog-name','none-'+t+'-'+clog_nid++)}~
|
||||
if(e.attr('data-clog-name') === undefined){e.attr('data-clog-name',e.attr('id'))}~
|
||||
~{~A~}~
|
||||
if(e.attr('data-clog-type') === undefined){e.attr('data-clog-type','span')}})"
|
||||
panel-uid
|
||||
(clog::jquery 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*))))
|
||||
(clog::js-execute content tmp))
|
||||
(let* ((data (first-child content))
|
||||
(name (attribute data "data-clog-title")))
|
||||
(when name
|
||||
(unless (equalp name "undefined")
|
||||
(setf (attribute content "data-clog-name") name)
|
||||
(destroy data))))
|
||||
(labels ((add-siblings (control)
|
||||
(let (dct)
|
||||
(loop
|
||||
(when (equal (html-id control) "undefined") (return))
|
||||
(setf dct (attribute control "data-clog-type"))
|
||||
(unless (equal dct "undefined")
|
||||
(change-class control (getf (control-info dct) :clog-type))
|
||||
(setup-control content control :win win)
|
||||
(add-siblings (first-child control)))
|
||||
(setf control (next-sibling control))))))
|
||||
(add-siblings (first-child content)))))
|
||||
(add-sub-controls content content :win win))
|
||||
|
||||
(defun on-populate-control-list-win (content)
|
||||
"Populate the control-list-window to allow drag and drop adjust of order
|
||||
|
|
@ -690,6 +694,7 @@ of controls and double click to select control."
|
|||
(setf file-name fname)
|
||||
(setf (inner-html content)
|
||||
(escape-string (read-file fname)))
|
||||
(clrhash (get-control-list app panel-id))
|
||||
(on-populate-loaded-window content :win win)
|
||||
(setf panel-name (attribute content "data-clog-name"))
|
||||
(setf (window-title win) panel-name))))))
|
||||
|
|
@ -875,6 +880,7 @@ of controls and double click to select control."
|
|||
(setf file-name fname)
|
||||
(setf (inner-html content)
|
||||
(escape-string (read-file fname)))
|
||||
(clrhash (get-control-list app panel-id))
|
||||
(on-populate-loaded-window content :win win)
|
||||
(setf panel-name (attribute content "data-clog-name"))
|
||||
(setf (title (html-document body)) panel-name)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue