diff --git a/clog.asd b/clog.asd index 4d5eff1..5607b8e 100644 --- a/clog.asd +++ b/clog.asd @@ -75,6 +75,7 @@ (:file "clog-db-admin") ;; clog-builder code (:file "clog-builder-settings") + (:file "clog-builder-settings-controls") (:file "clog-builder") (:file "clog-builder-control-events") (:file "clog-builder-control-properties") diff --git a/tools/clog-builder-control-list.lisp b/tools/clog-builder-control-list.lisp index eab2230..af7f241 100644 --- a/tools/clog-builder-control-list.lisp +++ b/tools/clog-builder-control-list.lisp @@ -61,7 +61,7 @@ (setf (select-tool app) nil) (setf (control-list-win app) nil))) (reset-control-pallete pallete) - (window-toggle-pinned win :state t) + (window-toggle-pinned win :state nil) (set-geometry win :units "" :top "33px" :left 0 :height "" :bottom "5px" :right "") (set-geometry pallete :left 0 :top 0 :height sheight :right 0);:width (- swidth 10)) (setf (background-color divider) :black) diff --git a/tools/clog-builder-control-properties.lisp b/tools/clog-builder-control-properties.lisp index ce14d5a..bc4ecf6 100644 --- a/tools/clog-builder-control-properties.lisp +++ b/tools/clog-builder-control-properties.lisp @@ -12,7 +12,7 @@ (setf (control-properties-win app) nil))) (set-on-window-move win (lambda (obj) (setf (height obj) (height obj)))) - (window-toggle-pinned win :state t) + (window-toggle-pinned win :state nil) (setf (control-properties-win app) win) (setf (properties-list app) control-list) (setf (background-color content) :silver) diff --git a/tools/clog-builder-files.lisp b/tools/clog-builder-files.lisp index 0c935e3..518a6b0 100644 --- a/tools/clog-builder-files.lisp +++ b/tools/clog-builder-files.lisp @@ -237,6 +237,7 @@ (window-focus win) (when fname (setf file-name fname) + (setf (window-title win) fname) (add-class btn-save "w3-animate-top") (write-file (text-value ace) fname :clog-obj obj) (setf is-dirty nil) diff --git a/tools/clog-builder-panels.lisp b/tools/clog-builder-panels.lisp index 3c04719..afe983f 100644 --- a/tools/clog-builder-panels.lisp +++ b/tools/clog-builder-panels.lisp @@ -863,6 +863,7 @@ not a temporarily attached one when using select-control." (lambda (fname) (window-focus win) (when fname + (setf file-name fname) (do-save obj fname data))) :initial-filename file-name)) (t diff --git a/tools/clog-builder-settings.lisp b/tools/clog-builder-settings.lisp index 8b1ce74..944fc31 100644 --- a/tools/clog-builder-settings.lisp +++ b/tools/clog-builder-settings.lisp @@ -38,2382 +38,3 @@ showGutter : true, enableBasicAutocompletion: true, enableLiveAutocompletion : true") - -(defparameter *import-types* - (list '(:tag "label" - :control "label") - '(:tag "input" - :control "input") - '(:tag "form" - :control "form") - '(:tag "button" - :control "button") - '(:tag "a" - :control "link") - '(:tag "img" - :control "image") - '(:tag "meter" - :control "meter") - '(:tag "progress" - :control "progress") - '(:tag "ol" - :control "ol") - '(:tag "ul" - :control "ul") - '(:tag "li" - :control "li") - '(:tag "li" - :control "li") - '(:tag "table" - :control "table") - '(:tag "tr" - :control "tr") - '(:tag "td" - :control "td") - '(:tag "th" - :control "th") - '(:tag "thead" - :control "thead") - '(:tag "tbody" - :control "tbody") - '(:tag "tfoot" - :control "tfoot") - '(:tag "caption" - :control "tcaption") - '(:tag "colgroup" - :control "tcolgroup") - '(:tag "col" - :control "tcol") - '(:tag "span" - :control "span") - '(:tag "textarea" - :control "textarea") - '(:tag "style" - :control "style-block") - '(:tag "fieldset" - :control "fieldset") - '(:tag "legend" - :control "legend") - '(:tag "datalist" - :control "datalist") - '(:tag "select" - :control "dropdown") - '(:tag "option" - :control "option") - '(:tag "optgroup" - :control "optgroup") - '(:tag "dialog" - :control "dialog") - '(:tag "p" - :control "p") - '(:tag "br" - :control "br") - '(:tag "hr" - :control "hr") - '(:tag "dl" - :control "dl") - '(:tag "dt" - :control "dt") - '(:tag "dd" - :control "dd") - '(:tag "details" - :control "details") - '(:tag "summary" - :control "summary") - '(:tag "div" - :control "div"))) - -(defparameter *props-location* - `((:name "top" - :setup ,(lambda (control td1 td2) - (declare (ignore control td1)) - (add-class td2 "clog-prop-top")) - :get ,(lambda (control) - (if (equal (positioning control) "static") - "n/a" - (top control))) - :set ,(lambda (control obj) - (setf (top control) (text obj)))) - (:name "left" - :setup ,(lambda (control td1 td2) - (declare (ignore control td1)) - (add-class td2 "clog-prop-left")) - :get ,(lambda (control) - (if (equal (positioning control) "static") - "n/a" - (left control))) - :set ,(lambda (control obj) - (setf (left control) (text obj)))) - (:name "bottom" - :setup ,(lambda (control td1 td2) - (declare (ignore control td1)) - (add-class td2 "clog-prop-bottom")) - :get ,(lambda (control) - (if (equal (positioning control) "static") - "n/a" - (bottom control))) - :set ,(lambda (control obj) - (setf (bottom control) (text obj)))) - (:name "right" - :setup ,(lambda (control td1 td2) - (declare (ignore control td1)) - (add-class td2 "clog-prop-right")) - :get ,(lambda (control) - (if (equal (positioning control) "static") - "n/a" - (right control))) - :set ,(lambda (control obj) - (setf (right control) (text obj)))) - (:name "positioning" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2)) - (v (string-downcase (positioning control)))) - (add-select-options dd '("absolute" - "static" - "relative" - "sticky" - "fixed")) - (set-geometry dd :width "100%") - (setf (value dd) v) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (when (equalp (value dd) "static") - (setf (top control) "") - (setf (left control) "")) - (setf (positioning control) (value dd)) - (set-geometry (get-placer control) - :top (position-top control) - :left (position-left control) - :width (client-width control) - :height (client-height control)) - (on-populate-control-properties-win obj))) - nil))))) - -(defparameter *props-with-height* - `((:name "width" - :setup ,(lambda (control td1 td2) - (declare (ignore control td1)) - (add-class td2 "clog-prop-width")) - :set ,(lambda (control obj) - (setf (width control) (text obj))) - :get ,(lambda (control) - (width control))) - (:name "height" - :setup ,(lambda (control td1 td2) - (declare (ignore control td1)) - (add-class td2 "clog-prop-height")) - :set ,(lambda (control obj) - (setf (height control) (text obj))) - :get ,(lambda (control) - (height control))))) - -(defparameter *props-form-values* - `((:name "value" - :prop "value") - (:name "default value" - :prop "defaultValue") - (:name "place holder" - :prop "placeholder") - (:name "name on form" - :prop "name") - (:name "size" - :prop "size") - (:name "image url" - :prop "src") - (:name "image alt" - :prop "alt") - (:name "checked" - :get ,(lambda (control) - (property control "checked")) - :set ,(lambda (control obj) - (if (equalp (text obj) "true") - (setf (checkedp control) t) - (setf (checkedp control) nil)) - (property control "required"))) - (:name "read only" - :get ,(lambda (control) - (property control "readonly")) - :set ,(lambda (control obj) - (if (equalp (text obj) "true") - (setf (read-only-p control) t) - (setf (read-only-p control) nil)) - (property control "readonly"))) - (:name "disabled" - :get ,(lambda (control) - (property control "disabled")) - :set ,(lambda (control obj) - (if (equalp (text obj) "true") - (setf (disabledp control) t) - (setf (disabledp control) nil)) - (property control "disabled"))) - (:name "required" - :get ,(lambda (control) - (property control "required")) - :set ,(lambda (control obj) - (if (equalp (text obj) "true") - (setf (requiredp control) t) - (setf (requiredp control) nil)) - (property control "required"))) - (:name "pattern" - :prop "pattern") - (:name "minimum" - :prop "min") - (:name "maximum" - :prop "max") - (:name "element step" - :prop "step") - (:name "minimum length" - :prop "minlength") - (:name "maximum length" - :prop "maxlength") - (:name "multiple" - :get ,(lambda (control) - (property control "multiple")) - :set ,(lambda (control obj) - (if (equalp (text obj) "true") - (setf (multiplep control) t) - (setf (multiplep control) nil)) - (property control "multiple"))) - (:name "files accepted" - :prop "accept"))) - -(defparameter *props-colors* - `((:name "color" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((d1 (create-form-element td2 :text :value (color control))) - (dd (create-form-element td2 :color :value (rgb-to-hex (color control))))) - (set-geometry d1 :width "100%") - (set-geometry dd :width "100%") - (make-data-list dd '("#ffffff" - "#000000" - "#ff0000" - "#00ff00" - "#0000ff")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (setf (value d1) (value dd)) - (setf (color control) (value d1)))) - (set-on-change d1 (lambda (obj) - (declare (ignore obj)) - (setf (color control) (value d1))))) - nil)) - (:name "opacity" - :style "opacity") - (:name "background color" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((d1 (create-form-element td2 :text :value (background-color control))) - (dd (create-form-element td2 :color :value (rgb-to-hex (background-color control))))) - (set-geometry d1 :width "100%") - (set-geometry dd :width "100%") - (make-data-list dd '("#ffffff" - "#000000" - "#ff0000" - "#00ff00" - "#0000ff")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (setf (value d1) (value dd)) - (setf (background-color control) (value d1)))) - (set-on-change d1 (lambda (obj) - (declare (ignore obj)) - (setf (background-color control) (value d1)))) - nil))) - (:name "background attachment" - :style "background-attachment") - (:name "background image" - :style "background-image") - (:name "background position" - :style "background-position") - (:name "background origin" - :style "background-origin") - (:name "background repeat" - :style "background-repeat") - (:name "background clip" - :style "background-clip") - (:name "background size" - :style "background-size") - (:name "border" - :style "border") - (:name "border radius" - :style "border-radius") - (:name "box shadow" - :style "box-shadow") - (:name "text shadow" - :style "text-shadow") - (:name "outline" - :style "outline") - (:name "margin" - :style "margin") - (:name "padding" - :style "padding") - (:name "cursor" - :style "cursor") - (:name "font" - :style "font") - (:name "text alignment" - :style "text-align") - (:name "vertical align" - :style "vertical-align"))) - -(defparameter *props-contents* - `((:name "contents" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (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)))) - -(defparameter *props-raw-contents* - `((:name "commands" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((exp (create-button td2 :content "convert to div"))) - (set-on-click exp (lambda (obj) - (setf (attribute control "data-clog-type") "div") - (remove-attribute control "data-original-html") - (remove-attribute control "data-clog-composite-control") - (clog-web-alert obj - "Convert to Div" - "Save and reload panel to access child controls." - :color-class "w3-yellow")))))) - (:name "html contents" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((app (connection-data-item td1 "builder-app-data")) - (d1 (create-text-area td2 :value (escape-string (attribute control "data-original-html") :html t)))) - (set-on-change d1 (lambda (obj) - (declare (ignore obj)) - (setf (attribute control "data-original-html") (value d1)) - (setf (inner-html control) (value d1))))) - nil)))) - -(defparameter *props-text* - `((:name "text" - :get ,(lambda (control) - (text-value control)) - :set ,(lambda (control obj) - (setf (text-value control) (text obj)))))) - -(defparameter *props-css* - `((:name "css classes" - :setup ,(lambda (control td1 td2) - (declare (ignore control td1)) - (add-class td2 "clog-prop-class")) - :get ,(lambda (control) - (property control "className")) - :set ,(lambda (control obj) - (setf (property control "className") (text obj)))))) - -(defparameter *props-display* - `((:name "hidden" - :get ,(lambda (control) - (property control "hidden")) - :set ,(lambda (control obj) - (if (equalp (text obj) "true") - (setf (hiddenp control) t) - (setf (hiddenp control) nil)) - (property control "hidden"))) - (:name "visible" - :get ,(lambda (control) - (style control "visibility")) - :set ,(lambda (control obj) - (if (or (equalp (text obj) "true") - (equalp (text obj) "visible")) - (setf (visiblep control) t) - (setf (visiblep control) nil)) - (style control "visibility"))) - (:name "display" - :style "display") - (:name "editable" - :prop "contenteditable") - (:name "spell check" - :prop "spellcheck") - (:name "text direction" - :prop "test-direction") - (:name "language code" - :prop "lang") - (:name "overflow" - :style "overflow") - (:name "resizable" - :style "resize") - (:name "minimum width" - :style "min-width") - (:name "minimum height" - :style "min-height") - (:name "maximum width" - :style "max-width") - (:name "maximum height" - :style "max-height"))) - -(defparameter *props-nav* - '((:name "access key" - :prop "access key") - (:name "tool tip" - :prop "title") - (:name "tab index" - :prop "tabindex") - (:name "z index" - :style "z-index"))) - -(defparameter *props-flex* -`((:name "flex-direction" - :style "flex-direction") - (:name "flex-wrap" - :style "flex-wrap") - (:name "flex-flow" - :style "flex-flow") - (:name "justify-content" - :style "justify-content") - (:name "align-items" - :style "align-items") - (:name "align-content" - :style "align-content"))) - -(defparameter *props-flex-item* -`((:name "flex-grow" - :style "flex-grow") - (:name "flex-shrink" - :style "flex-shrink") - (:name "flex-basis" - :style "flex-basis") - (:name "align-self" - :style "align-self") - (:name "order" - :style "order"))) - -(defparameter *props-base* - `(,@*props-location* - ,@*props-with-height* - ,@*props-css* - ,@*props-colors* - ,@*props-display* - ,@*props-flex-item* - ,@*props-nav*)) - -(defparameter *props-element* - `(,@*props-location* - ,@*props-with-height* - ,@*props-text* - ,@*props-css* - ,@*props-colors* - ,@*props-display* - ,@*props-flex-item* - ,@*props-nav*)) - -(defparameter *props-form-element* - `(,@*props-location* - ,@*props-with-height* - (:name "type" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2)) - (v (string-downcase (attribute control "type")))) - (add-select-options dd '("button" "checkbox" "color" "date" - "datetime" "datetime-local" "email" - "image" "file" "hidden" - "month" "number" "password" "radio" - "range" "reset" "search" "submit" - "tel" "text" "time" "url" "week")) - (set-geometry dd :width "100%") - (setf (value dd) v) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (setf (attribute control "type") (value dd)) - (set-geometry (get-placer control) - :top (position-top control) - :left (position-left control) - :width (client-width control) - :height (client-height control)))) - nil))) - (:name "data list" - :get ,(lambda (control) - (clog::js-query control (format nil "$('#~A').attr('data-clog-name')" - (attribute control "list")))) - :set ,(lambda (control obj) - (setf (attribute control "list") - (clog::js-query control (format nil "$(\"[data-clog-name='~A']\").attr('id')" - (text obj)))))) - ,@*props-form-values* - ,@*props-css* - ,@*props-colors* - ,@*props-display* - ,@*props-flex-item* - ,@*props-nav*)) - -(defparameter *props-w3css* - `((:name "Add Color Class" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2))) - (add-select-options dd `("" "w3-amber" "w3-aqua" "w3-blue" "w3-light-blue" - "w3-brown" "w3-cyan" "w3-blue-grey" "w3-green" - "w3-light-green" "w3-indigo" "w3-khaki" "w3-lime" - "w3-orange" "w3-deep-orange" "w3-pink" "w3-purple" - "w3-deep-purple" "w3-red" "w3-sand" "w3-teal" - "w3-yellow" "w3-white" "w3-black" "w3-grey" - "w3-light-grey" "w3-dark-grey" "w3-pale-red" - "w3-pale-green" "w3-pale-yellow" "w3-pale-blue")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (add-class control (value dd)) - (set-property-display control "class" (css-class-name control)))) - nil))) - (:name "Add Text Color Class" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2))) - (add-select-options dd `("" "w3-text-amber" "w3-text-aqua" "w3-text-blue" "w3-text-light-blue" - "w3-text-brown" "w3-text-cyan" "w3-text-blue-grey" "w3-text-green" - "w3-text-light-green" "w3-text-indigo" "w3-text-khaki" "w3-text-lime" - "w3-text-orange" "w3-text-deep-orange" "w3-text-pink" "w3-text-purple" - "w3-text-deep-purple" "w3-text-red" "w3-text-sand" "w3-text-teal" - "w3-text-yellow" "w3-text-white" "w3-text-black" "w3-text-grey" - "w3-text-light-grey" "w3-text-dark-grey" "w3-text-pale-red" - "w3-text-pale-green" "w3-text-pale-yellow" "w3-text-pale-blue")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (add-class control (value dd)) - (set-property-display control "class" (css-class-name control)))) - nil))) - (:name "Add Hover Text Color Class" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2))) - (add-select-options dd `("" "w3-hover-text-amber" "w3-hover-text-aqua" "w3-hover-text-blue" "w3-hover-text-light-blue" - "w3-hover-text-brown" "w3-hover-text-cyan" "w3-hover-text-blue-grey" "w3-hover-text-green" - "w3-hover-text-light-green" "w3-hover-text-indigo" "w3-hover-text-khaki" "w3-hover-text-lime" - "w3-hover-text-orange" "w3-hover-text-deep-orange" "w3-hover-text-pink" "w3-hover-text-purple" - "w3-hover-text-deep-purple" "w3-hover-text-red" "w3-hover-text-sand" "w3-hover-text-teal" - "w3-hover-text-yellow" "w3-hover-text-white" "w3-hover-text-black" "w3-hover-text-grey" - "w3-hover-text-light-grey" "w3-hover-text-dark-grey" "w3-hover-text-pale-red" - "w3-hover-text-pale-green" "w3-hover-text-pale-yellow" "w3-hover-text-pale-blue")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (add-class control (value dd)) - (set-property-display control "class" (css-class-name control)))) - nil))) - (:name "Add Border Class" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2))) - (add-select-options dd `("" "w3-border" "w3-border-top" "w3-border-right" "w3-border-bottom" - "w3-border-left" "w3-border-0" "w3-bottombar" "w3-leftbar" - "w3-rightbar" "w3-topbar")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (add-class control (value dd)) - (set-property-display control "class" (css-class-name control)))) - nil))) - (:name "Add Border Color Class" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2))) - (add-select-options dd `("" "w3-border-amber" "w3-border-aqua" "w3-border-blue" "w3-border-light-blue" - "w3-border-brown" "w3-border-cyan" "w3-border-blue-grey" "w3-border-green" - "w3-border-light-green" "w3-border-indigo" "w3-border-khaki" "w3-border-lime" - "w3-border-orange" "w3-border-deep-orange" "w3-border-pink" "w3-border-purple" - "w3-border-deep-purple" "w3-border-red" "w3-border-sand" "w3-border-teal" - "w3-border-yellow" "w3-border-white" "w3-border-black" "w3-border-grey" - "w3-border-light-grey" "w3-border-dark-grey" "w3-border-pale-red" - "w3-border-pale-green" "w3-border-pale-yellow" "w3-border-pale-blue")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (add-class control (value dd)) - (set-property-display control "class" (css-class-name control)))) - nil))) - (:name "Add Hover Border Color Class" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2))) - (add-select-options dd `("" "w3-hover-border-amber" "w3-hover-border-aqua" "w3-hover-border-blue" "w3-hover-border-light-blue" - "w3-hover-border-brown" "w3-hover-border-cyan" "w3-hover-border-blue-grey" "w3-hover-border-green" - "w3-hover-border-light-green" "w3-hover-border-indigo" "w3-hover-border-khaki" "w3-hover-border-lime" - "w3-hover-border-orange" "w3-hover-border-deep-orange" "w3-hover-border-pink" "w3-hover-border-purple" - "w3-hover-border-deep-purple" "w3-hover-border-red" "w3-hover-border-sand" "w3-hover-border-teal" - "w3-hover-border-yellow" "w3-hover-border-white" "w3-hover-border-black" "w3-hover-border-grey" - "w3-hover-border-light-grey" "w3-hover-border-dark-grey" "w3-hover-border-pale-red" - "w3-hover-border-pale-green" "w3-hover-border-pale-yellow" "w3-hover-border-pale-blue")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (add-class control (value dd)) - (set-property-display control "class" (css-class-name control)))) - nil))) - (:name "Add Round Class" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2))) - (add-select-options dd `("" "w3-circle" "w3-round-small" "w3-round" "w3-round-medium" - "w3-round-large" "w3-round-xlarge" "w3-round-xxlarge")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (add-class control (value dd)) - (set-property-display control "class" (css-class-name control)))) - nil))) - (:name "Add 3D Class" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2))) - (add-select-options dd `("" "w3-card" "w3-card-2" "w3-card-4" "w3-hover-shadow" "w3-hoverable" "w3-hover-none")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (add-class control (value dd)) - (set-property-display control "class" (css-class-name control)))) - nil))) - (:name "Add Visibility Class" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2))) - (add-select-options dd `("" "w3-opacity" "w3-opacity-min" "w3-opacity-max" - "w3-grayscale" "w3-grayscale-min" "w3-grayscale-max" - "w3-sepia" "w3-sepia-min" "w3-sepia-max" - "w3-hover-opacity" "w3-hover-grayscale" "w3-hover-sepia" - "w3-hover-opacity-off")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (add-class control (value dd)) - (set-property-display control "class" (css-class-name control)))) - nil))) - (:name "Add Font Class" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2))) - (add-select-options dd `("" "w3-serif" "w3-sans-serif" "w3-cursive" "w3-monospace" - "w3-wide")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (add-class control (value dd)) - (set-property-display control "class" (css-class-name control)))) - nil))) - (:name "Add Size Class" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2))) - (add-select-options dd `("" "w3-tiny" "w3-small" "w3-medium" "w3-large" - "w3-xlarge" "w3-xxlarge" "w3-xxxlarge" "w3-jumbo")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (add-class control (value dd)) - (set-property-display control "class" (css-class-name control)))) - nil))) - (:name "Add Alignmnet Class" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2))) - (add-select-options dd `("" "w3-mobile" "w3-responsive" - "w3-left-align" "w3-right-align" "w3-justify" - "w3-center" "w3-right" "w3-left" "w3-top" "w3-bottom" "w3-block" - "w3-bar" "w3-bar-block" "w3-bar-item" "w3-sidebar" - "w3-show-inline-block" "w3-dropdown-hover" - "w3-dropdown-click" "w3-collapse" - "w3-hide-small" "w3-hide-medium" "w3-hide-large")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (add-class control (value dd)) - (set-property-display control "class" (css-class-name control)))) - nil))) - (:name "Add Margins/Padding Class" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2))) - (add-select-options dd `("" "w3-margin" "w3-margin-top" "w3-margin-right" - "w3-margin-bottom" "w3-margin-left" "w3-section" - "w3-padding" "w3-padding-small" "w3-padding-large" - "w3-padding-16" "w3-padding-24" "w3-padding-32" - "w3-padding-48" "w3-padding-64")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (add-class control (value dd)) - (set-property-display control "class" (css-class-name control)))) - nil))) - (:name "Add Animation Class" - :setup ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2))) - (add-select-options dd `("" "w3-animate-top" "w3-animate-bottom" "w3-animate-left" - "w3-animate-right" "w3-animate-opacity" "w3-animate-zoom" - "w3-animate-fading" "w3-animate-input" "w3-spin")) - (set-on-change dd (lambda (obj) - (declare (ignore obj)) - (add-class control (value dd)) - (set-property-display control "class" (css-class-name control)))) - nil))))) - -(defparameter *events-multimedia* - '((:name "on-media-abort" - :parameters "target") - (:name "on-media-error" - :parameters "target") - (:name "on-can-play" - :parameters "target") - (:name "on-can-play-through" - :parameters "target") - (:name "on-duration-change" - :parameters "target") - (:name "on-emptied" - :parameters "target") - (:name "on-ended" - :parameters "target") - (:name "on-loaded-data" - :parameters "target") - (:name "on-loaded-meta-data" - :parameters "target") - (:name "on-load-start" - :parameters "target") - (:name "on-play" - :parameters "target") - (:name "on-pause" - :parameters "target") - (:name "on-playing" - :parameters "target") - (:name "on-progress" - :parameters "target") - (:name "on-rate-change" - :parameters "target") - (:name "on-seek" - :parameters "target") - (:name "on-seeked" - :parameters "target") - (:name "on-seeking" - :parameters "target") - (:name "on-stalled" - :parameters "target") - (:name "on-suspend" - :parameters "target") - (:name "on-time-updat" - :parameters "target") - (:name "on-volume-change" - :parameters "target") - (:name "on-waiting" - :parameters "target"))) - -(defparameter *events-element* - '((:name "on-create" - :parameters "target") - (:name "on-click" - :parameters "target" - :js-event "onclick") - (:name "on-focus" - :parameters "target" - :js-event "onfocus") - (:name "on-blur" - :parameters "target" - :js-event "onblur") - (:name "on-change" - :parameters "target" - :js-event "onchange") - (:name "on-input" - :parameters "target" - :js-event "oninput") - (:name "on-focus-in" - :parameters "target" - :js-event "onfocusin") - (:name "on-focus-out" - :parameters "target" - :js-event "onfocusout") - (:name "on-reset" - :parameters "target" - :js-event "onreset") - (:name "on-search" - :parameters "target" - :js-event "onsearch") - (:name "on-select" - :parameters "target" - :js-event "onselect") - (:name "on-submit" - :parameters "target" - :js-event "onsubmit") - (:name "on-context-menu" - :parameters "target" - :js-event "oncontextmenu") - (:name "on-double-click" - :parameters "target" - :js-event "ondblclick") - (:name "on-mouse-click" - :parameters "target data" - :js-event "onmouseclick") - (:name "on-mouse-double-click" - :parameters "target data" - :js-event "onmousedoubleclick") - (:name "on-mouse-right-click" - :parameters "target data" - :js-event "onmouserightclick") - (:name "on-mouse-enter" - :parameters "target" - :js-event "onmouseenter") - (:name "on-mouse-leave" - :parameters "target" - :js-event "onmouseleave") - (:name "on-mouse-over" - :parameters "target" - :js-event "onmouseover") - (:name "on-mouse-out" - :parameters "target" - :js-event "onmouseout") - (:name "on-mouse-down" - :parameters "target data" - :js-event "onmousedown") - (:name "on-mouse-up" - :parameters "target data" - :js-event "onmouseup") - (:name "on-mouse-move" - :parameters "target data" - :js-event "onmousemove") - (:name "on-pointer-enter" - :parameters "target" - :js-event "onpointerenter") - (:name "on-pointer-leave" - :parameters "target" - :js-event "onpointerleave") - (:name "on-pointer-over" - :parameters "target" - :js-event "onpointerover") - (:name "on-pointer-out" - :parameters "target" - :js-event "onpointerout") - (:name "on-pointer-down" - :parameters "target data" - :js-event "onpointerdown") - (:name "on-pointer-up" - :parameters "target data" - :js-event "onpointerup") - (:name "on-pointer-move" - :parameters "target data" - :js-event "onpointermove") - (:name "on-touch-start" - :parameters "target data" - :js-event "ontouchstart") - (:name "on-touch-move" - :parameters "target data" - :js-event "ontouchmove") - (:name "on-touch-end" - :parameters "target data" - :js-event "ontouchend") - (:name "on-touch-cancel" - :parameters "target data" - :js-event "ontouchcancel") - (:name "on-character" - :parameters "target data") - (:name "on-key-down" - :parameters "target data" - :js-event "onkeydown") - (:name "on-key-up" - :parameters "target data" - :js-event "onkeyup") - (:name "on-key-press" - :parameters "target data" - :js-event "onkeypress") - (:name "on-copy" - :parameters "target" - :js-event "oncopy") - (:name "on-cut" - :parameters "target" - :js-event "oncut") - (:name "on-paste" - :parameters "target" - :js-event "onpaste") - (:name "on-resize" - :parameters "target" - :js-event "onresize") - (:name "on-drag-start" - :parameters "target" - :js-event "ondragstart") - (:name "on-drag" - :parameters "target" - :js-event "ondrag") - (:name "on-drag-end" - :parameters "target" - :js-event "ondragend") - (:name "on-drag-enter" - :parameters "target" - :js-event "ondragenter") - (:name "on-drag-leave" - :parameters "target" - :js-event "ondragleave") - (:name "on-drag-over" - :parameters "target" - :js-event "ondragover") - (:name "on-drop" - :parameters "target data" - :js-event "ondrop"))) - -(defparameter *supported-controls* - (list - '(:name "group" - :description "Tools" - :create nil - :create-type nil - :events nil - :properties nil) - '(:name "select" - :description "Selection Tool" - :create nil - :create-type nil - :events nil - :properties nil) - `(:name "custom" - :description "Custom HTML" - :clog-type clog:clog-element - :create clog:create-child - :create-type :custom-query - :create-content "
" - :events (,@*events-element*) - :properties (,@*props-element*)) - `(:name "block" - :description "Custom HTML Block" - :clog-type clog:clog-div - :create clog:create-div - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (setf (attribute control "data-clog-composite-control") "b")) - :create-type :custom-block - :create-content "" - :events (,@*events-element*) - :properties (,@*props-element* - ,@*props-raw-contents*)) - `(:name "style-block" - :description "Style Block" - :clog-type clog:clog-style-block - :create clog:create-style-block - :create-type :base - :positioning :static - :events (,@*events-element*) - :properties ((:name "media" - :attr "media") - (:name "type" - :prop "type") - ,@*props-contents*)) - '(:name "group" - :description "Alignment Controls" - :create nil - :create-type nil - :events nil - :properties nil) - `(:name "flex-row" - :description "Row Align" - :clog-type clog:clog-div - :create clog:create-div - :create-type :element - :create-content "" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (set-geometry control :width 200 :height 28) - (setf (display control) :flex) - (setf (flex-direction control) :row)) - :events (,@*events-element*) - :properties (,@*props-flex* - ,@*props-element*)) - `(:name "flex-row-rev" - :description "Row Reverse Align" - :clog-type clog:clog-div - :create clog:create-div - :create-type :element - :create-content "" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (set-geometry control :width 200 :height 28) - (setf (display control) :flex) - (setf (flex-direction control) :row-reverse)) - :events (,@*events-element*) - :properties (,@*props-flex* - ,@*props-element*)) - `(:name "flex-col" - :description "Column Align" - :clog-type clog:clog-div - :create clog:create-div - :create-type :element - :create-content "" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (set-geometry control :width 100 :height 200) - (setf (display control) :flex) - (setf (flex-direction control) :column)) - :events (,@*events-element*) - :properties (,@*props-flex* - ,@*props-element*)) - `(:name "flex-col-rev" - :description "Column Reverse Align" - :clog-type clog:clog-div - :create clog:create-div - :create-type :element - :create-content "" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (set-geometry control :width 100 :height 200) - (setf (display control) :flex) - (setf (flex-direction control) :column-reverse)) - :events (,@*events-element*) - :properties (,@*props-flex* - ,@*props-element*)) - `(:name "flex-center" - :description "Center Align" - :clog-type clog:clog-div - :create clog:create-div - :create-type :element - :create-content "" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (set-geometry control :width 200 :height 200) - (setf (display control) :flex) - (setf (align-items control) :center) - (setf (justify-content control) :center)) - :events (,@*events-element*) - :properties (,@*props-flex* - ,@*props-element*)) - '(:name "group" - :description "Basic HTML Controls" - :create nil - :create-type nil - :events nil - :properties nil) - `(:name "label" - :description "Label" - :clog-type clog:clog-label - :create clog:create-label - :create-type :element - :create-content "Label" - :events (,@*events-element*) - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (setf (attribute control "data-clog-for") "")) - :on-setup ,(lambda (control control-record) - (declare (ignore control-record)) - (unless (equal (attribute control "data-clog-for") "") - (format nil - "(setf (attribute target \"for\") ~ - (clog:js-query target \"$('[data-clog-name=\\\\'~A\\\\']\').attr('id')\"))" - (attribute control "data-clog-for")))) - :properties ((:name "for" - :get ,(lambda (control) - (attribute control "data-clog-for")) - :set ,(lambda (control obj) - (setf (attribute control "data-clog-for") (text obj)) - (setf (attribute control "for") - (js-query control (format nil "$(\"[data-clog-name='~A']\").attr('id')" - (text obj)))))) - ,@*props-element*)) - `(:name "button" - :description "Button" - :clog-type clog:clog-button - :create clog:create-button - :create-type :element - :create-content "Button" - :events (,@*events-element*) - :properties (,@*props-element*)) - `(:name "div" - :description "Div" - :clog-type clog:clog-div - :create clog:create-div - :create-type :element - :create-content "div" - :events (,@*events-element*) - :properties (,@*props-element*)) - `(:name "textarea" - :description "Text Area" - :clog-type clog:clog-text-area - :create clog:create-text-area - :create-type :textarea - :create-value "" - :events (,@*events-element*) - :properties ((:name "rows" - :prop "rows") - (:name "columns" - :prop "columns") - (:name "word wrap" - :prop "wrap") - ,@*props-form-element*)) - `(:name "dropdown" - :description "Drop down select" - :clog-type clog:clog-select - :create clog:create-select - :create-type :base - :events (,@*events-element*) - :properties ((:name "multiple select" - :get ,(lambda (control) - (property control "multiple")) - :set ,(lambda (control obj) - (if (or (equalp (text obj) "true") (equalp (text obj) "multiple")) - (setf (attribute control "multiple") t) - (remove-attribute control "multiple")) - (property control "multiple"))) - ,@*props-form-element*)) - `(:name "listbox" - :description "Listbox select" - :clog-type clog:clog-select - :create clog:create-select - :create-type :base - :setup ,(lambda (control content control-record) - (declare (ignore content) (ignore control-record)) - (setf (size control) "4")) - :events (,@*events-element*) - :properties ((:name "multiple select" - :get ,(lambda (control) - (property control "multiple")) - :set ,(lambda (control obj) - (if (or (equalp (text obj) "true") (equalp (text obj) "multiple")) - (setf (attribute control "multiple") t) - (remove-attribute control "multiple")) - (property control "multiple"))) - ,@*props-form-element*)) - `(:name "option" - :description "Option Item" - :clog-type clog:clog-option - :create clog:create-option - :create-content "option item" - :create-type :element - :events (,@*events-element*) - :properties ((:name "value" - :prop "value") - (:name "selected" - :get ,(lambda (control) - (property control "selected")) - :set ,(lambda (control obj) - (if (or (equalp (text obj) "true") (equalp (text obj) "selected")) - (setf (attribute control "selected") t) - (remove-attribute control "selected")) - (property control "selected"))) - (:name "disabled" - :get ,(lambda (control) - (property control "disabled")) - :set ,(lambda (control obj) - (if (or (equalp (text obj) "true") (equalp (text obj) "disabled")) - (setf (attribute control "disabled") t) - (remove-attribute control "disabled")) - (property control "disabled"))) - ,@*props-element*)) - `(:name "optgroup" - :description "Option Group" - :clog-type clog:clog-optgroup - :create clog:create-optgroup - :create-content "option group" - :create-type :element - :events (,@*events-element*) - :properties ((:name "disabled" - :get ,(lambda (control) - (property control "disabled")) - :set ,(lambda (control obj) - (if (or (equalp (text obj) "true") (equalp (text obj) "disabled")) - (setf (attribute control "disabled") t) - (remove-attribute control "disabled")) - (property control "disabled"))) - ,@*props-element*)) - `(:name "image" - :description "Image" - :clog-type clog:clog-img - :create clog:create-img - :create-type :base - :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")) - :events (,@*events-element*) - :properties ((:name "image url" - :prop "src") - (:name "alternative text" - :prop "alt") - ,@*props-base*)) - `(:name "meter" - :description "Meter" - :clog-type clog:clog-meter - :create clog:create-meter - :create-type :base - :events (,@*events-element*) - :properties ((:name "value" - :prop "value") - (:name "high" - :prop "high") - (:name "low" - :prop "low") - (:name "maximum" - :prop "max") - (:name "minimum" - :prop "min") - (:name "optimum" - :prop "optimum") - ,@*props-base*)) - `(:name "progress" - :description "Progress Bar" - :clog-type clog:clog-progress-bar - :create clog:create-progress-bar - :create-type :base - :events (,@*events-element*) - :properties ((:name "value" - :prop "value") - (:name "maximum" - :prop "max") - ,@*props-base*)) - `(:name "dialog" - :description "Dialog" - :clog-type clog:clog-dialog - :create clog:create-dialog - :create-type :element - :create-content "" - :events (,@*events-element*) - :properties ((:name "open" - :get ,(lambda (control) - (property control "open")) - :set ,(lambda (control obj) - (if (or (equalp (text obj) "true") (equalp (text obj) "open")) - (setf (attribute control "open") t) - (remove-attribute control "open")) - (property control "open"))) - (:name "return value" - :prop "returnValue") - ,@*props-element*)) - '(:name "group" - :description "Form Controls" - :create nil - :create-type nil - :events nil - :properties nil) - `(:name "form" - :description "Form" - :clog-type clog:clog-form - :create clog:create-form - :create-type :base - :events (,@*events-element*) - :properties ((:name "action" - :attr "action") - (:name "target" - :attr "target") - (:name "method" - :attr "method") - (:name "encoding" - :prop "encoding") - (:name "form element count" - :get ,(lambda (control) (form-element-count control))) - ,@*props-element*)) - `(:name "input" - :description "Form Input" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :text - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "fbutton" - :description "Form Button" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :button - :create-value "Button" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "reset" - :description "Form Reset" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :reset - :create-value "Reset" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "submit" - :description "Form Submit" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :submit - :create-value "Submit" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "checkbox" - :description "Form Checkbox" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :checkbox - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "radio" - :description "Form Radio Button" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :radio - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "color" - :description "Form Color Picker" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :color - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "date" - :description "Form Date Picker" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :date - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "datetime" - :description "Form Datetime Picker" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :datetime - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "datetime-local" - :description "Form Datetime Local Picker" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :datetime-local - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "email" - :description "Form Email Input" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :email - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "file" - :description "Form File Input" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :file - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "hidden" - :description "Form Hidden Value" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :hidden - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "fimage" - :description "Form Image Input" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :image - :create-value "" - :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")) - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "month" - :description "Form Month and Year Picker" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :month - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "number" - :description "Form Number Picker" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :number - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "password" - :description "Form Password Input" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :password - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "range" - :description "Form Range Picker" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :range - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "search" - :description "Form Search Input" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :search - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "tel" - :description "Form Tel Input" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :tel - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "time" - :description "Form Time Picker" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :time - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "url" - :description "Form URL Input" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :url - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "week" - :description "Form Week Input" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :week - :create-value "" - :events (,@*events-element*) - :properties (,@*props-form-element*)) - `(:name "fieldset" - :description "Fieldset" - :clog-type clog:clog-fieldset - :create clog:create-fieldset - :create-type :base - :events (,@*events-element*) - :properties (,@*props-base*)) - `(:name "legend" - :description "Fieldset Legend" - :clog-type clog:clog-legend - :create clog:create-legend - :create-content "Legend here" - :create-type :element - :events (,@*events-element*) - :properties (,@*props-element*)) - `(:name "datalist" - :description "Data list" - :clog-type clog:clog-data-list - :create clog:create-data-list - :create-type :base - :events (,@*events-element*) - :properties (,@*props-base*)) - '(:name "group" - :description "Text Display Elements" - :create nil - :create-type nil - :events nil - :properties nil) - `(:name "span" - :description "Span" - :clog-type clog:clog-span - :create clog:create-span - :create-type :element - :create-content "span" - :events (,@*events-element*) - :properties (,@*props-contents* - ,@*props-element*)) - `(:name "link" - :description "Link" - :clog-type clog:clog-a - :create clog:create-a - :create-type :element - :create-content "HTML Link" - :events (,@*events-element*) - :properties ((:name "href link" - :prop "href") - (:name "target" - :prop "target") - ,@*props-element*)) - `(:name "hr" - :description "Horizontal Rule" - :clog-type clog:clog-hr - :create clog:create-hr - :create-type :base - :events (,@*events-element*) - :properties (,@*props-base*)) - `(:name "br" - :description "Line Break" - :clog-type clog:clog-br - :create clog:create-br - :create-type :base - :events (,@*events-element*) - :properties (,@*props-base*)) - `(:name "p" - :description "Paragraph" - :clog-type clog:clog-p - :create clog:create-p - :create-content "Paragraph" - :create-type :element - :events (,@*events-element*) - :properties (,@*props-element*)) - `(:name "ol" - :description "Ordered List" - :clog-type clog:clog-ordered-list - :create clog:create-ordered-list - :create-type :base - :events (,@*events-element*) - :properties ((:name "list kind" - :prop "list-style-type") - (:name "list location" - :prop "list-style-position") - ,@*props-element*)) - `(:name "ul" - :description "Unordered List" - :clog-type clog:clog-unordered-list - :create clog:create-unordered-list - :create-type :base - :events (,@*events-element*) - :properties ((:name "value" - :prop "value") - ,@*props-element*)) - `(:name "li" - :description "List Item" - :clog-type clog:clog-list-item - :create clog:create-list-item - :create-type :element - :create-content "List Item" - :positioning :static - :events (,@*events-element*) - :properties (,@*props-element*)) - `(:name "table" - :description "Table" - :clog-type clog:clog-table - :create clog:create-table - :create-type :base - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (set-geometry control :width 200 :height 100)) - :events (,@*events-element*) - :properties (,@*props-base*)) - `(:name "tr" - :description "Table Row" - :clog-type clog:clog-table-row - :create clog:create-table-row - :create-type :base - :positioning :static - :events (,@*events-element*) - :properties (,@*props-base*)) - `(:name "td" - :description "Table Column" - :clog-type clog:clog-table-column - :create clog:create-table-column - :create-type :element - :create-content "Column" - :positioning :static - :events (,@*events-element*) - :properties ((:name "column span" - :attr "colspan") - (:name "row span" - :attr "rowspan") - ,@*props-element*)) - `(:name "th" - :description "Table Heading" - :clog-type clog:clog-table-heading - :create clog:create-table-heading - :create-type :element - :create-content "Heading" - :positioning :static - :events (,@*events-element*) - :properties ((:name "column span" - :attr "colspan") - (:name "row span" - :attr "rowspan") - (:name "abbreviated version" - :attr "abbr") - (:name "scope" - :attr "rowspan") - ,@*props-element*)) - `(:name "tcolgroup" - :description "Table Column Group" - :clog-type clog:clog-table-column-group - :create clog:create-table-column-group - :create-type :base - :positioning :static - :events (,@*events-element*) - :properties ((:name "span" - :attr "span") - ,@*props-base*)) - `(:name "tcol" - :description "Table Column Group Item" - :clog-type clog:clog-table-column-group-item - :create clog:create-table-column-group-item - :create-type :base - :create-content "Column Group Item" - :positioning :static - :events (,@*events-element*) - :properties ((:name "span" - :attr "span") - ,@*props-base*)) - `(:name "thead" - :description "Table Head" - :clog-type clog:clog-table-head - :create clog:create-table-head - :create-type :base - :positioning :static - :events (,@*events-element*) - :properties (,@*props-base*)) - `(:name "tbody" - :description "Table Body" - :clog-type clog:clog-table-body - :create clog:create-table-body - :create-type :base - :positioning :static - :events (,@*events-element*) - :properties (,@*props-base*)) - `(:name "tfoot" - :description "Table Footer" - :clog-type clog:clog-table-footer - :create clog:create-table-footer - :create-type :base - :positioning :static - :events (,@*events-element*) - :properties (,@*props-base*)) - `(:name "tcaption" - :description "Table Caption" - :clog-type clog:clog-table-caption - :create clog:create-table-caption - :create-type :element - :create-content "Caption" - :positioning :static - :events (,@*events-element*) - :properties ((:name "caption side" - :style "caption-side") - ,@*props-element*)) - `(:name "dl" - :description "Definition List" - :clog-type clog:clog-definition-list - :create clog:create-definition-list - :create-type :base - :events (,@*events-element*) - :properties (,@*props-base*)) - `(:name "dt" - :description "Definition Term" - :clog-type clog:clog-term - :create clog:create-term - :create-content "Term" - :create-type :element - :positioning :static - :events (,@*events-element*) - :properties (,@*props-element*)) - `(:name "dd" - :description "Definition Description" - :clog-type clog:clog-description - :create clog:create-description - :create-content "Description" - :create-type :element - :positioning :static - :events (,@*events-element*) - :properties (,@*props-element*)) - `(:name "details" - :description "Details Block" - :clog-type clog:clog-details - :create clog:create-details - :create-type :element - :create-content "Details" - :events (,@*events-element*) - :properties ((:name "open" - :get ,(lambda (control) - (property control "open")) - :set ,(lambda (control obj) - (if (or (equalp (text obj) "true") (equalp (text obj) "open")) - (setf (attribute control "open") t) - (remove-attribute control "open")) - (property control "open"))) - ,@*props-element*)) - `(:name "summary" - :description "Summary Block" - :clog-type clog:clog-summary - :create clog:create-summary - :create-content "Summary" - :create-type :element - :events (,@*events-element*) - :properties (,@*props-element*)) - '(:name "group" - :description "W3.CSS Controls" - :create nil - :create-type nil - :events nil - :properties nil) - `(:name "w3-button" - :description "W3-Button" - :clog-type clog:clog-button - :create clog:create-button - :create-type :element - :create-content "w3-button" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (setf (css-class-name control) "w3-button w3-ripple w3-border")) - :events (,@*events-element*) - :properties (,@*props-w3css* - ,@*props-element*)) - `(:name "w3-btn" - :description "W3-Btn" - :clog-type clog:clog-button - :create clog:create-button - :create-type :element - :create-content "w3-btn" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (setf (css-class-name control) "w3-btn w3-ripple w3-border")) - :events (,@*events-element*) - :properties (,@*props-w3css* - ,@*props-element*)) - `(:name "w3-image" - :description "W3-Image" - :clog-type clog:clog-img - :create clog:create-img - :create-type :base - :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") - (setf (css-class-name control) "w3-image")) - :events (,@*events-element*) - :properties ((:name "image url" - :prop "src") - (:name "alternative text" - :prop "alt") - ,@*props-w3css* - ,@*props-base*)) - `(:name "w3-input" - :description "W3-Form Input" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :text - :create-value "" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (set-geometry control :width 200) - (setf (css-class-name control) "w3-input")) - :events (,@*events-element*) - :properties (,@*props-w3css* - ,@*props-form-element*)) - `(:name "w3-checkbox" - :description "W3-Form Checkbox" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :checkbox - :create-value "" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (setf (css-class-name control) "w3-check")) - :events (,@*events-element*) - :properties (,@*props-w3css* - ,@*props-form-element*)) - `(:name "w3-radio" - :description "W3-Form Radio Button" - :clog-type clog:clog-form-element - :create clog:create-form-element - :create-type :form - :create-param :radio - :create-value "" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (setf (css-class-name control) "w3-radio")) - :events (,@*events-element*) - :properties (,@*props-w3css* - ,@*props-form-element*)) - `(:name "w3-dropdown" - :description "W3-Drop down select" - :clog-type clog:clog-select - :create clog:create-select - :create-type :base - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (set-geometry control :width 200) - (setf (css-class-name control) "w3-select")) - :events (,@*events-element*) - :properties ((:name "multiple select" - :get ,(lambda (control) - (property control "multiple")) - :set ,(lambda (control obj) - (if (or (equalp (text obj) "true") (equalp (text obj) "multiple")) - (setf (attribute control "multiple") t) - (remove-attribute control "multiple")) - (property control "multiple"))) - ,@*props-w3css* - ,@*props-form-element*)) - `(:name "w3-table" - :description "W3-Table" - :clog-type clog:clog-table - :create clog:create-table - :create-type :base - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (set-geometry control :width 200 :height 100) - (setf (css-class-name control) "w3-table w3-striped w3-border w3-bordered w3-hoverable")) - :events (,@*events-element*) - :properties (,@*props-w3css* - ,@*props-base*)) - `(:name "w3-ul" - :description "W3-Unordered List" - :clog-type clog:clog-unordered-list - :create clog:create-unordered-list - :create-type :base - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (set-geometry control :width 200 :height 100) - (setf (css-class-name control) "w3-ul w3-hoverable")) - :events (,@*events-element*) - :properties ((:name "value" - :prop "value") - ,@*props-w3css* - ,@*props-element*)) - `(:name "w3-badge" - :description "W3-Badge" - :clog-type clog:clog-span - :create clog:create-span - :create-type :element - :create-content "7" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (setf (css-class-name control) "w3-badge")) - :events (,@*events-element*) - :properties (,@*props-w3css* - ,@*props-contents* - ,@*props-element*)) - `(:name "w3-tag" - :description "W3-Tag" - :clog-type clog:clog-span - :create clog:create-span - :create-type :element - :create-content "tag" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (setf (css-class-name control) "w3-tag")) - :events (,@*events-element*) - :properties (,@*props-w3css* - ,@*props-contents* - ,@*props-element*)) - `(:name "w3-container" - :description "W3-Container" - :clog-type clog:clog-div - :create clog:create-div - :create-type :element - :create-content "w3-container" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (set-geometry control :width 200 :height 100) - (setf (css-class-name control) "w3-container w3-card-2")) - :events (,@*events-element*) - :properties (,@*props-w3css* - ,@*props-element*)) - `(:name "w3-code-div" - :description "W3-Code-Div" - :clog-type clog:clog-div - :create clog:create-div - :create-type :element - :create-content "code" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (set-geometry control :width 200 :height 100) - (setf (css-class-name control) "w3-code w3-border")) - :events (,@*events-element*) - :properties (,@*props-w3css* - ,@*props-element*)) - `(:name "w3-codespan" - :description "W3-Codespan" - :clog-type clog:clog-span - :create clog:create-span - :create-type :element - :create-content "code span" - :setup ,(lambda (control content control-record) - (declare (ignore content control-record)) - (setf (css-class-name control) "w3-codespan")) - :events (,@*events-element*) - :properties (,@*props-w3css* - ,@*props-contents* - ,@*props-element*)) - '(:name "group" - :description "Multi-Media Controls" - :create nil - :create-type nil - :events nil - :properties nil) - `(:name "audio" - :description "Audio Player" - :clog-type clog:clog-audio - :create clog:create-audio - :create-type :base - :events (,@*events-multimedia* - ,@*events-element*) - :properties ((:name "media url" - :prop "src") - (:name "volume" - :prop "volume") - (:name "controls" - :attr "controls") - (:name "preload" - :attr "preload") - (:name "autoplay" - :attr "autoplay") - (:name "muted" - :prop "muted") - (:name "loop" - :prop "loop") - ,@*props-base*)) - `(:name "video" - :description "Video Player" - :clog-type clog:clog-video - :create clog:create-video - :create-type :base - :events (,@*events-multimedia* - ,@*events-element*) - :properties ((:name "media url" - :prop "src") - (:name "volume" - :prop "volume") - (:name "controls" - :attr "controls") - (:name "preload" - :attr "preload") - (:name "autoplay" - :attr "autoplay") - (:name "muted" - :prop "muted") - (:name "loop" - :prop "loop") - ,@*props-base*)) - '(:name "group" - :description "Graphics Controls" - :create nil - :create-type nil - :events nil - :properties nil) - `(:name "canvas" - :description "Canvas" - :clog-type clog:clog-canvas - :create clog:create-canvas - :create-type :base - :on-setup ,(lambda (control control-record) - (declare (ignore control-record)) - (format nil "(setf (attribute target \"width\") ~A)~ - (setf (attribute target \"height\") ~A)" - (width control) - (height control))) - :events (,@*events-element*) - :properties (,@*props-base*)) - '(:name "group" - :description "Database Controls" - :create nil - :create-type nil - :events nil - :properties nil) - `(:name "database" - :description "Database" - :clog-type clog:clog-database - :create clog:create-database - :create-type :base - :positioning :static - :setup ,(lambda (control content control-record) - (declare (ignore content) (ignore control-record)) - (setf (attribute control "data-clog-dbi-dbtype") ":sqlite3") - (setf (attribute control "data-clog-dbi-dbname") ":memory:") - (setf (attribute control "data-clog-dbi-dbparams") "")) - :on-setup ,(lambda (control control-record) - (declare (ignore control-record)) - (format nil "(setf (database-connection target) ~ - (dbi:connect ~A ~A :database-name ~A))" - (attribute control "data-clog-dbi-dbtype") - (attribute control "data-clog-dbi-dbparams") - (let ((dbi-name (attribute control "data-clog-dbi-dbname"))) - (if (equal (char dbi-name 0) #\*) - dbi-name - (format nil "\"~A\"" - dbi-name))))) - :events (,@*events-element*) - :properties ((:name "database type" - :attr "data-clog-dbi-dbtype") - (:name "database params" - :attr "data-clog-dbi-dbparams") - (:name "database name" - :attr "data-clog-dbi-dbname") - ,@*props-element*)) - `(:name "one-row" - :description "One Row" - :clog-type clog:clog-one-row - :create clog:create-one-row - :create-type :base - :positioning :static - :setup ,(lambda (control content control-record) - (declare (ignore content) (ignore control-record)) - (setf (attribute control "data-clog-one-row-db") "") - (setf (attribute control "data-clog-one-row-table") "") - (setf (attribute control "data-clog-one-row-where") "") - (setf (attribute control "data-clog-one-row-order") "") - (setf (attribute control "data-clog-one-row-limit") "") - (setf (attribute control "data-clog-one-row-master") "") - (setf (attribute control "data-clog-one-row-id-name") "rowid") - (setf (attribute control "data-clog-one-row-columns") "rowid")) - :on-setup ,(lambda (control control-record) - (declare (ignore control-record)) - (let ((parent (attribute (parent-element control) "data-clog-name")) - (cdb (attribute control "data-clog-one-row-db")) - (master (attribute control "data-clog-one-row-master"))) - (if (or (equal cdb "") - (equal cdb "undefined")) - (setf cdb parent)) - (when (equal master "") - (setf master nil)) - (format nil "(setf (clog-database target) (clog-database (~A panel))) ~ - ~A ~ - (setf (table-name target) \"~A\") ~ - (setf (where-clause target) \"~A\") ~ - (setf (order-by target) \"~A\") ~ - (setf (limit target) \"~A\") ~ - (setf (row-id-name target) \"~A\") ~ - (setf (table-columns target) '(~A))" - cdb - (if master - (format nil "(set-master-one-row target (~A panel) \"~A\")" - cdb master) - "") - (attribute control "data-clog-one-row-table") - (attribute control "data-clog-one-row-where") - (attribute control "data-clog-one-row-order") - (attribute control "data-clog-one-row-limit") - (attribute control "data-clog-one-row-id-name") - (attribute control "data-clog-one-row-columns")))) - :events ((:name "on-fetch" - :parameters "target") - ,@*events-element*) - :properties ((:name "database control" - :attr "data-clog-one-row-db") - (:name "table name" - :attr "data-clog-one-row-table") - (:name "table row id name" - :attr "data-clog-one-row-id-name") - (:name "table columns" - :attr "data-clog-one-row-columns") - (:name "where clause (optional)" - :attr "data-clog-one-row-where") - (:name "order by (optional)" - :attr "data-clog-one-row-order") - (:name "limit (optional)" - :attr "data-clog-one-row-limit") - (:name "join to slot-name (optional)" - :attr "data-clog-one-row-master") - ,@*props-element*)) - `(:name "db-table" - :description "Table Many Rows" - :clog-type clog:clog-db-table - :create clog:create-db-table - :create-type :base - :positioning :static - :setup ,(lambda (control content control-record) - (declare (ignore content) (ignore control-record)) - (setf (attribute control "data-clog-one-row-db") "") - (setf (attribute control "data-clog-one-row-table") "") - (setf (attribute control "data-clog-one-row-where") "") - (setf (attribute control "data-clog-one-row-order") "") - (setf (attribute control "data-clog-one-row-limit") "") - (setf (attribute control "data-clog-one-row-master") "") - (setf (attribute control "data-clog-one-row-id-name") "rowid") - (setf (attribute control "data-clog-one-row-columns") "rowid")) - :on-setup ,(lambda (control control-record) - (declare (ignore control-record)) - (let ((parent (attribute (parent-element control) "data-clog-name")) - (cdb (attribute control "data-clog-one-row-db")) - (master (attribute control "data-clog-one-row-master"))) - (if (or (equal cdb "") - (equal cdb "undefined")) - (setf cdb parent)) - (when (equal master "") - (setf master nil)) - (format nil "(setf (clog-database target) (clog-database (~A panel))) ~ - ~A ~ - (setf (table-name target) \"~A\") ~ - (setf (where-clause target) \"~A\") ~ - (setf (order-by target) \"~A\") ~ - (setf (limit target) \"~A\") ~ - (setf (row-id-name target) \"~A\") ~ - (setf (table-columns target) '(~A))" - cdb - (if master - (format nil "(set-master-one-row target (~A panel) \"~A\")" - cdb master) - "") - (attribute control "data-clog-one-row-table") - (attribute control "data-clog-one-row-where") - (attribute control "data-clog-one-row-order") - (attribute control "data-clog-one-row-limit") - (attribute control "data-clog-one-row-id-name") - (attribute control "data-clog-one-row-columns")))) - :events ((:name "on-fetch" - :parameters "target") - (:name "on-header" - :parameters "target") - (:name "on-footer" - :parameters "target") - (:name "on-row" - :parameters "target table-row") - (:name "on-column" - :parameters "target column table-column") - ,@*events-element*) - :properties ((:name "database control" - :attr "data-clog-one-row-db") - (:name "table name" - :attr "data-clog-one-row-table") - (:name "table row id name" - :attr "data-clog-one-row-id-name") - (:name "table columns" - :attr "data-clog-one-row-columns") - (:name "where clause (optional)" - :attr "data-clog-one-row-where") - (:name "order by (optional)" - :attr "data-clog-one-row-order") - (:name "limit (optional)" - :attr "data-clog-one-row-limit") - (:name "join to slot-name (optional)" - :attr "data-clog-one-row-master") - ,@*props-element*)) - `(:name "lookup-drop" - :description "Drop down table lookup" - :clog-type clog:clog-lookup - :create clog:create-lookup - :create-type :base - :setup ,(lambda (control content control-record) - (declare (ignore content) (ignore control-record)) - (setf (attribute control "data-clog-one-row-db") "") - (setf (attribute control "data-clog-one-row-table") "") - (setf (attribute control "data-clog-lookup-value") "") - (setf (attribute control "data-clog-lookup-option") "") - (setf (attribute control "data-clog-one-row-where") "") - (setf (attribute control "data-clog-one-row-order") "") - (setf (attribute control "data-clog-one-row-limit") "") - (setf (attribute control "data-clog-one-row-master") "") - (setf (attribute control "data-clog-one-row-id-name") "rowid") - (setf (attribute control "data-clog-one-row-columns") "rowid")) - :on-setup ,(lambda (control control-record) - (declare (ignore control-record)) - (let ((parent (attribute (parent-element control) "data-clog-name")) - (cdb (attribute control "data-clog-one-row-db")) - (master (attribute control "data-clog-one-row-master"))) - (if (or (equal cdb "") - (equal cdb "undefined")) - (setf cdb parent)) - (when (equal master "") - (setf master nil)) - (format nil "(setf (clog-database target) (clog-database (~A panel))) ~ - ~A ~ - (setf (table-name target) \"~A\") ~ - (setf (value-field target) :|~A|) ~ - (setf (option-field target) :|~A|) ~ - (setf (where-clause target) \"~A\") ~ - (setf (order-by target) \"~A\") ~ - (setf (limit target) \"~A\") ~ - (setf (row-id-name target) \"~A\") ~ - (setf (table-columns target) '(~A))" - cdb - (if master - (format nil "(set-master-one-row target (~A panel) \"~A\")" - cdb master) - "") - (attribute control "data-clog-one-row-table") - (attribute control "data-clog-lookup-value") - (attribute control "data-clog-lookup-option") - (attribute control "data-clog-one-row-where") - (attribute control "data-clog-one-row-order") - (attribute control "data-clog-one-row-limit") - (attribute control "data-clog-one-row-id-name") - (attribute control "data-clog-one-row-columns")))) - :events ((:name "on-fetch" - :parameters "target") - ,@*events-element*) - :properties ((:name "multiple select" - :get ,(lambda (control) - (property control "multiple")) - :set ,(lambda (control obj) - (if (or (equalp (text obj) "true") (equalp (text obj) "multiple")) - (setf (attribute control "multiple") t) - (remove-attribute control "multiple")) - (property control "multiple"))) - (:name "database control" - :attr "data-clog-one-row-db") - (:name "table name" - :attr "data-clog-one-row-table") - (:name "table row id name" - :attr "data-clog-one-row-id-name") - (:name "table columns" - :attr "data-clog-one-row-columns") - (:name "value field" - :attr "data-clog-lookup-value") - (:name "value display field" - :attr "data-clog-lookup-option") - (:name "where clause (optional)" - :attr "data-clog-one-row-where") - (:name "order by (optional)" - :attr "data-clog-one-row-order") - (:name "limit (optional)" - :attr "data-clog-one-row-limit") - (:name "join to slot-name (optional)" - :attr "data-clog-one-row-master") - ,@*props-form-element*)) - `(:name "lookup-list" - :description "Listbox table lookup" - :clog-type clog:clog-lookup - :create clog:create-lookup - :create-type :base - :setup ,(lambda (control content control-record) - (declare (ignore content) (ignore control-record)) - (setf (size control) "4") - (setf (attribute control "data-clog-one-row-db") "") - (setf (attribute control "data-clog-one-row-table") "") - (setf (attribute control "data-clog-lookup-value") "") - (setf (attribute control "data-clog-lookup-option") "") - (setf (attribute control "data-clog-one-row-where") "") - (setf (attribute control "data-clog-one-row-order") "") - (setf (attribute control "data-clog-one-row-limit") "") - (setf (attribute control "data-clog-one-row-master") "") - (setf (attribute control "data-clog-one-row-id-name") "rowid") - (setf (attribute control "data-clog-one-row-columns") "rowid")) - :on-setup ,(lambda (control control-record) - (declare (ignore control-record)) - (let ((parent (attribute (parent-element control) "data-clog-name")) - (cdb (attribute control "data-clog-one-row-db")) - (master (attribute control "data-clog-one-row-master"))) - (if (or (equal cdb "") - (equal cdb "undefined")) - (setf cdb parent)) - (when (equal master "") - (setf master nil)) - (format nil "(setf (clog-database target) (clog-database (~A panel))) ~ - ~A ~ - (setf (table-name target) \"~A\") ~ - (setf (value-field target) :|~A|) ~ - (setf (option-field target) :|~A|) ~ - (setf (where-clause target) \"~A\") ~ - (setf (order-by target) \"~A\") ~ - (setf (limit target) \"~A\") ~ - (setf (row-id-name target) \"~A\") ~ - (setf (table-columns target) '(~A))" - cdb - (if master - (format nil "(set-master-one-row target (~A panel) \"~A\")" - cdb master) - "") - (attribute control "data-clog-one-row-table") - (attribute control "data-clog-lookup-value") - (attribute control "data-clog-lookup-option") - (attribute control "data-clog-one-row-where") - (attribute control "data-clog-one-row-order") - (attribute control "data-clog-one-row-limit") - (attribute control "data-clog-one-row-id-name") - (attribute control "data-clog-one-row-columns")))) - :events ((:name "on-fetch" - :parameters "target") - ,@*events-element*) - :properties ((:name "multiple select" - :get ,(lambda (control) - (property control "multiple")) - :set ,(lambda (control obj) - (if (or (equalp (text obj) "true") (equalp (text obj) "multiple")) - (setf (attribute control "multiple") t) - (remove-attribute control "multiple")) - (property control "multiple"))) - (:name "database control" - :attr "data-clog-one-row-db") - (:name "table name" - :attr "data-clog-one-row-table") - (:name "table row id name" - :attr "data-clog-one-row-id-name") - (:name "table columns" - :attr "data-clog-one-row-columns") - (:name "value field" - :attr "data-clog-lookup-value") - (:name "value display field" - :attr "data-clog-lookup-option") - (:name "where clause (optional)" - :attr "data-clog-one-row-where") - (:name "order by (optional)" - :attr "data-clog-one-row-order") - (:name "limit (optional)" - :attr "data-clog-one-row-limit") - (:name "join to slot-name (optional)" - :attr "data-clog-one-row-master") - ,@*props-form-element*)))) - -(defparameter *supported-templates* - (list - '(:name "CLOG Builder - Panel Projects" - :code :group) - '(:name "Centered Panel Project" - :code "nbp" - :type :system - :www "templates/www/" - :loc "templates/projects/clog-panel/") - '(:name "Full browser Panel Project" - :code "nfp" - :type :system - :www "templates/www/" - :loc "templates/projects/full-screen/") - '(:name "CLOG-GUI MDI Panel Project" - :code "nmp" - :type :system - :www "templates/www/" - :loc "templates/projects/clog-gui-panel/") - '(:name "CLOG-GUI SDI Panel Project" - :code "nsp" - :type :system - :www "templates/www/" - :loc "templates/projects/clog-gui-sdi/") - '(:name "CLOG - General Projects" - :code :group) - '(:name "Basic HTML Project" - :code "ncp" - :type :system - :www "templates/www/" - :loc "templates/projects/clog/") - '(:name "CLOG-GUI Project" - :code "ncgp" - :type :system - :www "templates/www/" - :loc "templates/projects/clog-gui/") - '(:name "CLOG-WEB Project" - :code "ncwp" - :type :system - :www "templates/www/" - :loc "templates/projects/clog-web/") - '(:name "CLOG-WEB-SITE Project" - :code "ncws" - :type :system - :www "templates/www/" - :loc "templates/projects/clog-web-site/") - '(:name "CLOG/CLOG Builder - Extension Projects" - :code :group) - '(:name "CLOG/CLOG Builder Plugin Project" - :code "ncplug" - :type :system - :www "templates/www/" - :loc "templates/projects/clog-plugin/") - '(:name "General Common Lisp Applications" - :code :group) - '(:name "Console Application" - :code "nca" - :type :system - :loc "templates/projects/console/"))) diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index b19b9a8..22d7169 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -450,10 +450,14 @@ clog-builder window.") (set-geometry (current-window body) :top 38 :left 5 :right "" :height "" :bottom 22) (set-geometry (current-window body) :height (height (current-window body)) :bottom (bottom (current-window body)))) - (on-dir-win body :dir *start-dir*) + (handler-case + (on-dir-win body :dir *start-dir*) + (error (msg) + (alert-toast body "Directory Error" (format nil "Unable to open directory ~A. " *start-dir*)) + (setf *start-dir* nil))) (set-geometry (current-window body) :top 38 :left "" :right 5 :height "" :bottom 22) (set-geometry (current-window body) :height (height (current-window body)) - :bottom (bottom (current-window body)))))) + :bottom (bottom (current-window body)))))) (set-on-before-unload (window body) (lambda(obj) (declare (ignore obj)) ;; return empty string to prevent nav off page