diff --git a/VSCODE.md b/VSCODE.md new file mode 100644 index 0000000..8bb5f15 --- /dev/null +++ b/VSCODE.md @@ -0,0 +1,23 @@ +Using VSCODE instead of emacs: + +- Install Common-Lisp (you can skip the emacs portion) + +* [Install Common-Lisp for MacOS](MACOS.md) +* [Install Common-Lisp for Win64](WINDOWS.md) +* [Install Common-Lisp for Linux](https://lisp-lang.org/learn/getting-started/) + +- Update asdf by git cloning the latest version in to ~/common-lisp or another asdf reachable location + +git clone https://github.com/fare/asdf.git + +- Download and install vscode + +- Go to - https://marketplace.visualstudio.com/items?itemName=rheller.alive + +Click install and follow directions + +- Cmd+Shift+P - type shell command + +Go through install + +- load up a .lisp file and the REPL should load \ No newline at end of file diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index 202c21e..aac3b9f 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -102,10 +102,10 @@ (defun remove-deleted-from-control-list (app panel-id) "Remove any deleted control from control-list" (maphash (lambda (html-id control) - (when (equalp (clog:js-query control (format nil "$.contains(document.documentElement, ~A)" - (clog::script-id control))) "false") - (remove-from-control-list app panel-id html-id))) - (get-control-list app panel-id))) + (when (equalp (clog:js-query control (format nil "$.contains(document.documentElement, ~A)" + (clog::script-id control))) "false") + (remove-from-control-list app panel-id html-id))) + (get-control-list app panel-id))) ;; Handle per content next-id counts @@ -126,13 +126,13 @@ (defun capture-eval (form &key (eval-in-package "clog-user")) "Capture lisp evaluaton of FORM" (let ((result (make-array '(0) :element-type 'base-char - :fill-pointer 0 :adjustable t)) - (eval-result)) + :fill-pointer 0 :adjustable t)) + (eval-result)) (with-output-to-string (stream result) (let* ((*standard-output* stream) - (*error-output* stream) - (*package* (find-package (string-upcase eval-in-package)))) - (setf eval-result (eval (read-from-string (format nil "(progn ~A)" form)))))) + (*error-output* stream) + (*package* (find-package (string-upcase eval-in-package)))) + (setf eval-result (eval (read-from-string (format nil "(progn ~A)" form)))))) (format nil "~A~%=>~A~%" result eval-result))) ;; Local file utilities @@ -148,7 +148,7 @@ (defun write-file (string outfile &key (action-if-exists :rename)) "Write local file named OUTFILE" (check-type action-if-exists (member nil :error :new-version :rename :rename-and-delete - :overwrite :append :supersede)) + :overwrite :append :supersede)) (with-open-file (outstream outfile :direction :output :if-exists action-if-exists) (write-sequence string outstream))) @@ -159,28 +159,28 @@ (lambda (html-id control) (declare (ignore html-id)) (place-inside-bottom-of hide-loc - (get-placer control))) + (get-placer control))) (get-control-list app panel-id)) (let ((data - (create-child content "" - :html-id (format nil "I~A" (get-universal-time))))) + (create-child content "" + :html-id (format nil "I~A" (get-universal-time))))) (place-inside-top-of content data) (setf (attribute data "data-in-package") - (attribute content "data-in-package")) + (attribute content "data-in-package")) (setf (attribute data "data-custom-slots") - (attribute content "data-custom-slots")) + (attribute content "data-custom-slots")) (setf (attribute data "data-clog-next-id") - (attribute content "data-clog-next-id")) + (attribute content "data-clog-next-id")) (setf (attribute data "data-clog-title") - (attribute content "data-clog-name")) + (attribute content "data-clog-name")) (write-file (js-query content - (format nil - "var z=~a.clone();~ + (format nil + "var z=~a.clone();~ z.find('*').each(function(){if($(this).attr('id') !== undefined && ~ $(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~ z.html()" (clog::jquery content))) - fname) + fname) (destroy data)) (maphash (lambda (html-id control) @@ -193,11 +193,11 @@ (defun walk-files-and-directories (path process) "Walk PATH and apply PROCESS on each (path and file)" (let* ((flist (uiop:directory-files path)) - (dlist (uiop:subdirectories path))) + (dlist (uiop:subdirectories path))) (dolist (f flist) - (funcall process path (file-namestring f))) + (funcall process path (file-namestring f))) (dolist (d dlist) - (walk-files-and-directories d process)))) + (walk-files-and-directories d process)))) (defun template-copy (sys-name start-dir filename &key panel) "Copy START-DIR to FILENAME processing .lt files as cl-template files, @@ -207,35 +207,35 @@ create-div's" start-dir (lambda (path file) (let* ((tmpl-ext "lt") - (src-file (format nil "~A~A" - path file)) - (out-dir (format nil "~A/~A/~A" - filename - sys-name - (subseq (format nil "~A" path) - (length start-dir)))) - (out-file (format nil "~A~A" - out-dir - file))) + (src-file (format nil "~A~A" + path file)) + (out-dir (format nil "~A/~A/~A" + filename + sys-name + (subseq (format nil "~A" path) + (length start-dir)))) + (out-file (format nil "~A~A" + out-dir + file))) (ensure-directories-exist out-dir) (cond ((equalp (pathname-type file) tmpl-ext) - (let* ((nfile (pathname-name file)) - (afile (if (equalp (pathname-name nfile) "tmpl") - (format nil "~A~A.~A" out-dir sys-name (pathname-type nfile)) - (format nil "~A~A" out-dir nfile)))) - (write-file (funcall (cl-template:compile-template (read-file src-file)) - (list :sys-name sys-name)) - afile) - (when panel - (create-div panel - :content (format nil "~A -> ~A" - src-file afile))))) - (t - (uiop:copy-file src-file out-file) - (when panel - (create-div panel - :content (format nil "~A -> ~A" - src-file out-file))))))))) + (let* ((nfile (pathname-name file)) + (afile (if (equalp (pathname-name nfile) "tmpl") + (format nil "~A~A.~A" out-dir sys-name (pathname-type nfile)) + (format nil "~A~A" out-dir nfile)))) + (write-file (funcall (cl-template:compile-template (read-file src-file)) + (list :sys-name sys-name)) + afile) + (when panel + (create-div panel + :content (format nil "~A -> ~A" + src-file afile))))) + (t + (uiop:copy-file src-file out-file) + (when panel + (create-div panel + :content (format nil "~A -> ~A" + src-file out-file))))))))) ;; Control utilities @@ -243,68 +243,68 @@ create-div's" "Return control informaton record for CONTROL-TYPE-NAME from the *supported-controls* list." (if (equal control-type-name "clog-data") `(:name "clog-data" - :description "Panel Properties" - :events nil - :properties ((:name "in-package" - :attr "data-in-package") - (:name "custom slots" - :attr "data-custom-slots") - (:name "width" - :get ,(lambda (control) (width control)) - :setup :read-only) - (:name "height" - :setup :read-only - :get ,(lambda (control) (height control))))) + :description "Panel Properties" + :events nil + :properties ((:name "in-package" + :attr "data-in-package") + (:name "custom slots" + :attr "data-custom-slots") + (:name "width" + :get ,(lambda (control) (width control)) + :setup :read-only) + (:name "height" + :setup :read-only + :get ,(lambda (control) (height control))))) (find-if (lambda (x) (equal (getf x :name) control-type-name)) *supported-controls*))) (defun create-control (parent content control-record uid &key custom-query) "Return a new control based on CONTROL-RECORD as a child of PARENT" (let* ((create-type (getf control-record :create-type)) - (control-type-name (getf control-record :name)) - (control (cond ((eq create-type :base) - (funcall (getf control-record :create) parent - :html-id uid)) - ((eq create-type :custom) - (funcall (getf control-record :create) parent - (getf control-record :create-content) - :html-id uid)) - ((eq create-type :custom-query) - (funcall (getf control-record :create) parent - custom-query - :html-id uid)) - ((eq create-type :paste) - (let ((c (funcall (getf control-record :create) parent - custom-query - :html-id uid))) - (setf control-type-name (attribute c "data-clog-type")) - (change-class c (getf (control-info control-type-name) :clog-type)) - c)) - ((eq create-type :element) - (funcall (getf control-record :create) parent - :html-id uid - :content (if (equal (getf control-record :create-content) "") - "" - (format nil "~A-~A" - (getf control-record :create-content) - (next-id content))))) - ((eq create-type :form) - (funcall (getf control-record :create) parent - (getf control-record :create-param) - :html-id uid - :value (if (equal (getf control-record :create-value) "") - "" - (format nil "~A-~A" - (getf control-record :create-value) - (next-id content))))) - ((eq create-type :textarea) - (funcall (getf control-record :create) parent - :html-id uid - :value (getf control-record :create-value))) - (t nil)))) + (control-type-name (getf control-record :name)) + (control (cond ((eq create-type :base) + (funcall (getf control-record :create) parent + :html-id uid)) + ((eq create-type :custom) + (funcall (getf control-record :create) parent + (getf control-record :create-content) + :html-id uid)) + ((eq create-type :custom-query) + (funcall (getf control-record :create) parent + custom-query + :html-id uid)) + ((eq create-type :paste) + (let ((c (funcall (getf control-record :create) parent + custom-query + :html-id uid))) + (setf control-type-name (attribute c "data-clog-type")) + (change-class c (getf (control-info control-type-name) :clog-type)) + c)) + ((eq create-type :element) + (funcall (getf control-record :create) parent + :html-id uid + :content (if (equal (getf control-record :create-content) "") + "" + (format nil "~A-~A" + (getf control-record :create-content) + (next-id content))))) + ((eq create-type :form) + (funcall (getf control-record :create) parent + (getf control-record :create-param) + :html-id uid + :value (if (equal (getf control-record :create-value) "") + "" + (format nil "~A-~A" + (getf control-record :create-value) + (next-id content))))) + ((eq create-type :textarea) + (funcall (getf control-record :create) parent + :html-id uid + :value (getf control-record :create-value))) + (t nil)))) (when control (setf (attribute control "data-clog-type") control-type-name) (when (getf control-record :setup) - (funcall (getf control-record :setup) control content control-record))) + (funcall (getf control-record :setup) control content control-record))) control)) (defun drop-new-control (app content data &key win) @@ -313,113 +313,113 @@ create-div's" (when win (window-focus win)) (let* ((control-record (control-info (value (select-tool app)))) - (control-type-name (getf control-record :create-type))) + (control-type-name (getf control-record :create-type))) (if (eq control-type-name :custom-query) - (input-dialog win "Enter html (must have an outer element):" - (lambda (custom-query) - (when custom-query - (do-drop-new-control - app content data - :win win - :custom-query custom-query))) - :width 500 - :height 300 - :rows 5 - :size 40 - :title "Custom HTML Control" - :default-value (getf control-record :create-content)) - (do-drop-new-control app content data :win win)))) + (input-dialog win "Enter html (must have an outer element):" + (lambda (custom-query) + (when custom-query + (do-drop-new-control + app content data + :win win + :custom-query custom-query))) + :width 500 + :height 300 + :rows 5 + :size 40 + :title "Custom HTML Control" + :default-value (getf control-record :create-content)) + (do-drop-new-control app content data :win win)))) (defun do-drop-new-control (app content data &key win custom-query) "Create new control droppend at event DATA on CONTENT of WIN)" ;; create control (bordeaux-threads:with-lock-held ((new-control-lock app)) (let* ((control-record (control-info (value (select-tool app)))) - (control-type-name (getf control-record :name)) - (positioning (if (getf data :ctrl-key) - :static - :absolute)) - (parent (when (getf data :shift-key) - (current-control app))) - (control (create-control (if parent - parent - content) - content - control-record - (format nil "CLOGB~A~A" - (get-universal-time) - (next-id content)) - :custom-query custom-query))) + (control-type-name (getf control-record :name)) + (positioning (if (getf data :ctrl-key) + :static + :absolute)) + (parent (when (getf data :shift-key) + (current-control app))) + (control (create-control (if parent + parent + content) + content + control-record + (format nil "CLOGB~A~A" + (get-universal-time) + (next-id content)) + :custom-query custom-query))) (cond (control - ;; panel directly clicked with a control type selected - ;; setup control - (setf (attribute control "data-clog-name") - (format nil "~A-~A" control-type-name (next-id content))) - (setf (value (select-tool app)) 0) - (setf (box-sizing control) :content-box) - (setf (positioning control) positioning) - (set-geometry control - :left (getf data :x) - :top (getf data :y)) - (setup-control content control :win win) - (select-control control) - (add-sub-controls control content :win win) - (on-populate-control-list-win content) - t) - (t - ;; panel directly clicked with select tool or no control type to add - (deselect-current-control app) - (on-populate-control-properties-win content :win win) - (on-populate-control-list-win content) - nil))))) + ;; panel directly clicked with a control type selected + ;; setup control + (setf (attribute control "data-clog-name") + (format nil "~A-~A" control-type-name (next-id content))) + (setf (value (select-tool app)) 0) + (setf (box-sizing control) :content-box) + (setf (positioning control) positioning) + (set-geometry control + :left (getf data :x) + :top (getf data :y)) + (setup-control content control :win win) + (select-control control) + (add-sub-controls control content :win win) + (on-populate-control-list-win content) + t) + (t + ;; panel directly clicked with select tool or no control type to add + (deselect-current-control app) + (on-populate-control-properties-win content :win win) + (on-populate-control-list-win content) + nil))))) (defun setup-control (content control &key win) "Setup CONTROL by creating pacer and setting up events for manipulation" (let ((app (connection-data-item content "builder-app-data")) - (panel-id (html-id content)) - (placer (create-div control :auto-place nil :html-id (format nil "p-~A" (html-id control))))) + (panel-id (html-id content)) + (placer (create-div control :auto-place nil :html-id (format nil "p-~A" (html-id control))))) (add-to-control-list app panel-id control) ;; setup placer (set-geometry placer :top (position-top control) - :left (position-left control) - :width (client-width control) - :height (client-height control)) + :left (position-left control) + :width (client-width control) + :height (client-height control)) (place-after control placer) (setf (box-sizing placer) :content-box) (setf (positioning placer) :absolute) (clog::jquery-execute placer "draggable().resizable()") ;; setup control events (set-on-focus control (lambda (obj) - (declare (ignore obj)) - ;; set focus is bound in case control - ;; is set to static or reached using - ;; tab selection - (select-control obj))) + (declare (ignore obj)) + ;; set focus is bound in case control + ;; is set to static or reached using + ;; tab selection + (select-control obj))) ;; setup placer events (set-on-mouse-down placer - (lambda (obj data) - (declare (ignore obj) (ignore data)) - (select-control control) - (when win - (window-focus win))) - :cancel-event t) + (lambda (obj data) + (declare (ignore obj) (ignore data)) + (select-control control) + (when win + (window-focus win))) + :cancel-event t) (clog::set-on-event placer "resizestop" - (lambda (obj) - (set-geometry control :units "" - :width (width placer) - :height (height placer)) - (set-geometry placer :units "" - :width (client-width control) - :height (client-height control)) - (on-populate-control-properties-win content :win win))) + (lambda (obj) + (set-geometry control :units "" + :width (width placer) + :height (height placer)) + (set-geometry placer :units "" + :width (client-width control) + :height (client-height control)) + (on-populate-control-properties-win content :win win))) (clog::set-on-event placer "dragstop" - (lambda (obj) - (set-geometry control :units "" - :top (top placer) - :left (left placer)) - (set-geometry placer :top (top control) - :left (left control)) - (on-populate-control-properties-win content :win win))))) + (lambda (obj) + (set-geometry control :units "" + :top (top placer) + :left (left placer)) + (set-geometry placer :top (top control) + :left (left control)) + (on-populate-control-properties-win content :win win))))) ;; Control selection utilities @@ -450,12 +450,12 @@ manipulation of the control's location and size." The actual original clog object used for creation must be used and not a temporary attached one when using select-control." (let ((app (connection-data-item control "builder-app-data")) - (placer (get-placer control))) + (placer (get-placer control))) (deselect-current-control app) (set-geometry placer :top (top control) - :left (left control) - :width (client-width control) - :height (client-height control)) + :left (left control) + :width (client-width control) + :height (client-height control)) (setf (current-control app) control) (set-border placer (unit "px" 2) :solid :blue) (on-populate-control-properties-win control))) @@ -463,11 +463,11 @@ not a temporary attached one when using select-control." (defun add-sub-controls (parent content &key win paste) "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))) + (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;~ + "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))~ @@ -478,43 +478,43 @@ not a temporary attached one when using select-control." ~A ~ ~{~A~}~ if(e.attr('data-clog-type') === undefined){e.attr('data-clog-type','span')}})" - panel-uid - (clog::jquery parent) - (if paste - (prog1 - (format nil "e.attr('data-clog-name', e.attr('data-clog-name')+'-'+~A);" - (next-id content)) - (incf-next-id content)) - "") - (mapcar (lambda (l) - (format nil "if(p === undefined && t=='~A'){e.attr('data-clog-type','~A')}" - (getf l :tag) (getf l :control))) - *import-types*)))) + panel-uid + (clog::jquery parent) + (if paste + (prog1 + (format nil "e.attr('data-clog-name', e.attr('data-clog-name')+'-'+~A);" + (next-id content)) + (incf-next-id content)) + "") + (mapcar (lambda (l) + (format nil "if(p === undefined && t=='~A'){e.attr('data-clog-type','~A')}" + (getf l :tag) (getf l :control))) + *import-types*)))) (clog::js-execute parent tmp)) (let* ((data (first-child content)) - (name (attribute data "data-clog-title")) - (next-id (attribute data "data-clog-next-id")) - (slots (attribute data "data-custom-slots")) - (package (attribute data "data-in-package"))) + (name (attribute data "data-clog-title")) + (next-id (attribute data "data-clog-next-id")) + (slots (attribute data "data-custom-slots")) + (package (attribute data "data-in-package"))) (unless (equalp next-id "undefined") - (setf-next-id content next-id)) + (setf-next-id content next-id)) (unless (equalp package "undefined") - (setf (attribute content "data-in-package") package)) + (setf (attribute content "data-in-package") package)) (unless (equalp slots "undefined") - (setf (attribute content "data-custom-slots") slots)) + (setf (attribute content "data-custom-slots") slots)) (unless (equalp name "undefined") - (setf (attribute content "data-clog-name") name) - (destroy data))) + (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)))))) + (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))))) ;; Code rendering utlities @@ -522,103 +522,103 @@ not a temporary attached one when using select-control." (defun render-clog-code (content hide-loc) "Render panel to clog code and add tp CW window" (let* ((app (connection-data-item content "builder-app-data")) - (panel-id (html-id content)) - (package (attribute content "data-in-package")) - (slots (attribute content "data-custom-slots")) - (cname (attribute content "data-clog-name")) - cmembers vars events) + (panel-id (html-id content)) + (package (attribute content "data-in-package")) + (slots (attribute content "data-custom-slots")) + (cname (attribute content "data-clog-name")) + cmembers vars events) (unless (or (equal slots "") - (equal slots "undefined")) + (equal slots "undefined")) (push slots cmembers)) (maphash (lambda (html-id control) - (declare (ignore html-id)) - (place-inside-bottom-of hide-loc - (get-placer control))) - (get-control-list app panel-id)) + (declare (ignore html-id)) + (place-inside-bottom-of hide-loc + (get-placer control))) + (get-control-list app panel-id)) ;; crawl tree ;; Insure that on-setup/on-create follow order in tree (labels ((add-siblings (control) - (let (dct) - (loop - (when (equal (html-id control) "undefined") (return)) - (setf dct (attribute control "data-clog-name")) - (unless (equal dct "undefined") - (setf control (get-from-control-list app panel-id (html-id control))) - (let ((vname (attribute control "data-clog-name"))) - (unless (and (>= (length vname) 5) - (equalp (subseq vname 0 5) "none-")) - (push (format nil - " \(~A :reader ~A\)~%" - vname - vname) - cmembers) - (push (format nil - " \(setf (slot-value panel '~A\) ~ + (let (dct) + (loop + (when (equal (html-id control) "undefined") (return)) + (setf dct (attribute control "data-clog-name")) + (unless (equal dct "undefined") + (setf control (get-from-control-list app panel-id (html-id control))) + (let ((vname (attribute control "data-clog-name"))) + (unless (and (>= (length vname) 5) + (equalp (subseq vname 0 5) "none-")) + (push (format nil + " \(~A :reader ~A\)~%" + vname + vname) + cmembers) + (push (format nil + " \(setf (slot-value panel '~A\) ~ \(attach-as-child clog-obj \"~A\" :clog-type \'~A\ :new-id t)\)~%" - vname - (html-id control) - (format nil "CLOG:~A" (type-of control))) - vars) - (let ((control-record (control-info (attribute control "data-clog-type")))) - (dolist (event (getf control-record :events)) - (let ((handler (attribute control (format nil "data-~A" (getf event :name))))) - (unless (or (equalp handler "undefined") - (equal handler "")) - (unless (equalp (getf event :name) "on-create") - (push (format nil - " \(set-~A \(~A panel\) \(lambda \(~A\) \(declare \(ignorable ~A\)\) ~A\)\)~%" - (getf event :name) - vname - (getf event :parameters) - (getf event :parameters) - handler) - events))))) - (let ((handler (attribute control "data-on-create"))) - (when (equalp handler "undefined") - (setf handler "")) - (when (getf control-record :on-setup) - (setf handler (format nil "~A~A" - (funcall (getf control-record :on-setup) - control control-record) - handler))) - (unless (equal handler "") - (push (format nil - " \(let \(\(target \(~A panel\)\)\) ~ + vname + (html-id control) + (format nil "CLOG:~A" (type-of control))) + vars) + (let ((control-record (control-info (attribute control "data-clog-type")))) + (dolist (event (getf control-record :events)) + (let ((handler (attribute control (format nil "data-~A" (getf event :name))))) + (unless (or (equalp handler "undefined") + (equal handler "")) + (unless (equalp (getf event :name) "on-create") + (push (format nil + " \(set-~A \(~A panel\) \(lambda \(~A\) \(declare \(ignorable ~A\)\) ~A\)\)~%" + (getf event :name) + vname + (getf event :parameters) + (getf event :parameters) + handler) + events))))) + (let ((handler (attribute control "data-on-create"))) + (when (equalp handler "undefined") + (setf handler "")) + (when (getf control-record :on-setup) + (setf handler (format nil "~A~A" + (funcall (getf control-record :on-setup) + control control-record) + handler))) + (unless (equal handler "") + (push (format nil + " \(let \(\(target \(~A panel\)\)\) ~ \(declare \(ignorable target\)\) ~ ~A\)~%" - vname - handler) - events)))))) - (add-siblings (first-child control))) - (setf control (next-sibling control)))))) + vname + handler) + events)))))) + (add-siblings (first-child control))) + (setf control (next-sibling control)))))) (add-siblings (first-child content))) (let ((result (format nil - "\(in-package \"~A\"\) + "\(in-package \"~A\"\) \(defclass ~A \(clog:clog-panel\) \(~{~A~}\)\) \(defun create-~A \(clog-obj &key \(hidden nil\) \(class nil\) \(html-id nil\) \(auto-place t\)\) \(let \(\(panel \(change-class \(clog:create-div clog-obj :content \"~A\" :hidden hidden :class class :html-id html-id :auto-place auto-place\) \'~A\)\)\) ~{~A~}~{~A~} panel\)\)~%" - (string-upcase package) - cname ;;defclass - cmembers - cname ;;defun - (ppcre:regex-replace-all "\"" - (js-query content - (format nil - "var z=~a.clone();~ + (string-upcase package) + cname ;;defclass + cmembers + cname ;;defun + (ppcre:regex-replace-all "\"" + (js-query content + (format nil + "var z=~a.clone();~ z.find('*').each(function(){for(n in $(this).get(0).dataset){delete $(this).get(0).dataset[n]}});~ z.html()" - (clog::jquery content))) - "\\\"") - cname - vars - (reverse events)))) ; Insure that on-setup/on-create follow order in tree + (clog::jquery content))) + "\\\"") + cname + vars + (reverse events)))) ; Insure that on-setup/on-create follow order in tree (maphash (lambda (html-id control) - (declare (ignore html-id)) - (place-after control (get-placer control))) - (get-control-list app panel-id)) + (declare (ignore html-id)) + (place-after control (get-placer control))) + (get-control-list app panel-id)) result))) ;; Population of utility windows @@ -627,51 +627,51 @@ not a temporary attached one when using select-control." "Populate the control events for the current control" ;; obj if current-control is nil must be content (let* ((app (connection-data-item obj "builder-app-data")) - (event-win (control-events-win app)) - (control (if (current-control app) - (current-control app) - obj)) - (table (events-list app))) + (event-win (control-events-win app)) + (control (if (current-control app) + (current-control app) + obj)) + (table (events-list app))) (when event-win (setf (inner-html table) "") (let ((info (control-info (attribute control "data-clog-type"))) - events) - (dolist (event (reverse (getf info :events))) - (let ((attr (format nil "data-~A" (getf event :name)))) - (push `(,(getf event :name) - ,(let ((txt (attribute control attr))) - (if (equalp txt "undefined") - "" - txt)) - ,(getf event :parameters) - ,(getf event :setup) - ,(lambda (obj) - (let ((txt (text-value obj))) - (if (or (equal txt "") - (equalp txt "undefined")) - (remove-attribute control attr) - (setf (attribute control attr) (text-value obj)))))) - events))) - (dolist (item events) - (let* ((tr (create-table-row table)) - (td1 (create-table-column tr :content (first item))) - (td2 (create-table-column tr)) - (editor nil)) - (setf (width td1) "30%") - (setf (width td2) "70%") - (set-border td1 "1px" :dotted :black) - (setf (advisory-title td1) (format nil "params: panel ~A" (third item))) - (cond ((fourth item) - (setf editor td2) - (setf (editablep td2) (funcall (fourth item) control td1 td2))) - (t - (setf editor (create-text-area td2)) - (setf (spellcheckp editor) nil) - (setf (width editor) "95%"))) ; leave space for scroll bar - (setf (text-value editor) (second item)) - (set-on-blur editor - (lambda (obj) - (funcall (fifth item) obj))))))))) + events) + (dolist (event (reverse (getf info :events))) + (let ((attr (format nil "data-~A" (getf event :name)))) + (push `(,(getf event :name) + ,(let ((txt (attribute control attr))) + (if (equalp txt "undefined") + "" + txt)) + ,(getf event :parameters) + ,(getf event :setup) + ,(lambda (obj) + (let ((txt (text-value obj))) + (if (or (equal txt "") + (equalp txt "undefined")) + (remove-attribute control attr) + (setf (attribute control attr) (text-value obj)))))) + events))) + (dolist (item events) + (let* ((tr (create-table-row table)) + (td1 (create-table-column tr :content (first item))) + (td2 (create-table-column tr)) + (editor nil)) + (setf (width td1) "30%") + (setf (width td2) "70%") + (set-border td1 "1px" :dotted :black) + (setf (advisory-title td1) (format nil "params: panel ~A" (third item))) + (cond ((fourth item) + (setf editor td2) + (setf (editablep td2) (funcall (fourth item) control td1 td2))) + (t + (setf editor (create-text-area td2)) + (setf (spellcheckp editor) nil) + (setf (width editor) "95%"))) ; leave space for scroll bar + (setf (text-value editor) (second item)) + (set-on-blur editor + (lambda (obj) + (funcall (fifth item) obj))))))))) (defun on-populate-control-properties-win (obj &key win) "Populate the control properties for the current control" @@ -680,93 +680,93 @@ not a temporary attached one when using select-control." (bordeaux-threads:with-lock-held ((properties-lock app)) (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) :setf) - (push `(,(getf prop :name) ,(funcall (getf prop :setf) control) ,(getf prop :setup) - ,(lambda (obj) - (funcall (find-symbol (format nil "SET-~A" (getf prop :setf)) :clog) control (text 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) - (push - `("parent" ,(attribute (parent-element control) "data-clog-name") - nil - ,(lambda (obj) - (place-inside-bottom-of - (attach-as-child control - (clog::js-query - control - (format nil "$(\"[data-clog-name='~A']\").attr('id')" - (text obj)))) - control) - (place-after control placer))) - props)) - (push - `("name" ,(attribute control "data-clog-name") - nil - ,(lambda (obj) - (setf (attribute control "data-clog-name") (text obj)) - (when (equal (getf info :name) "clog-data") - (setf (window-title win) (text obj))))) - 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))) - (set-on-blur td2 - (lambda (obj) - (funcall (fourth item) obj) - (when placer - (set-geometry placer :top (position-top control) - :left (position-left control) - :width (client-width control) - :height (client-height control))))))))))))) + (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) :setf) + (push `(,(getf prop :name) ,(funcall (getf prop :setf) control) ,(getf prop :setup) + ,(lambda (obj) + (funcall (find-symbol (format nil "SET-~A" (getf prop :setf)) :clog) control (text 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) + (push + `("parent" ,(attribute (parent-element control) "data-clog-name") + nil + ,(lambda (obj) + (place-inside-bottom-of + (attach-as-child control + (clog::js-query + control + (format nil "$(\"[data-clog-name='~A']\").attr('id')" + (text obj)))) + control) + (place-after control placer))) + props)) + (push + `("name" ,(attribute control "data-clog-name") + nil + ,(lambda (obj) + (setf (attribute control "data-clog-name") (text obj)) + (when (equal (getf info :name) "clog-data") + (setf (window-title win) (text obj))))) + 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))) + (set-on-blur td2 + (lambda (obj) + (funcall (fourth item) obj) + (when placer + (set-geometry placer :top (position-top control) + :left (position-left control) + :width (client-width control) + :height (client-height control))))))))))))) (defun on-populate-loaded-window (content &key win) "Setup html imported in to CONTENT for use with Builder" @@ -778,82 +778,82 @@ of controls and double click to select control." (let ((app (connection-data-item content "builder-app-data"))) (bordeaux-threads:with-lock-held ((control-list-win-lock app)) (let ((panel-id (html-id content)) - (last-ctl nil)) - (when (control-list-win app) - (let ((win (window-content (control-list-win app)))) - (setf (inner-html win) "") - (labels ((add-siblings (control sim) - (let (dln) - (loop - (when (equal (html-id control) "undefined") (return)) - (setf dln (attribute control "data-clog-name")) - (unless (equal dln "undefined") - (let ((list-item (create-div win :content (format nil "↕ ~A~A" sim dln))) - (status (hiddenp (get-placer control)))) - (if status - (setf (background-color list-item) :gray) - (setf (background-color list-item) :lightgray)) - (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)) - (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)))) - ;; 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-list-win content)))) - (set-on-drag-start list-item (lambda (obj)(declare (ignore obj))()) - :drag-data (html-id control)) - (add-siblings (first-child control) (format nil "~A→" sim)))) - (setf control (next-sibling control)))))) - (add-siblings (first-child content) "")))))))) + (last-ctl nil)) + (when (control-list-win app) + (let ((win (window-content (control-list-win app)))) + (setf (inner-html win) "") + (labels ((add-siblings (control sim) + (let (dln) + (loop + (when (equal (html-id control) "undefined") (return)) + (setf dln (attribute control "data-clog-name")) + (unless (equal dln "undefined") + (let ((list-item (create-div win :content (format nil "↕ ~A~A" sim dln))) + (status (hiddenp (get-placer control)))) + (if status + (setf (background-color list-item) :gray) + (setf (background-color list-item) :lightgray)) + (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)) + (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)))) + ;; 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-list-win content)))) + (set-on-drag-start list-item (lambda (obj)(declare (ignore obj))()) + :drag-data (html-id control)) + (add-siblings (first-child control) (format nil "~A→" sim)))) + (setf control (next-sibling control)))))) + (add-siblings (first-child content) "")))))))) ;; Menu handlers @@ -864,117 +864,117 @@ of controls and double click to select control." ~A (create-~A body)) ~A:path \"/test\")~ (clog:open-browser :url \"http://127.0.0.1:8080/test\")" - form-string - (if custom-boot - "" - "(clog-gui:clog-gui-initialize body) + form-string + (if custom-boot + "" + "(clog-gui:clog-gui-initialize body) (clog-web:clog-web-initialize body :w3-css-url nil)") - cname - (if custom-boot - (format nil ":boot-file \"~A\" " custom-boot) - "")) - :eval-in-package package))) + cname + (if custom-boot + (format nil ":boot-file \"~A\" " custom-boot) + "")) + :eval-in-package package))) (alert-dialog obj result :title "Eval Result"))) (defun on-show-control-properties-win (obj) "Show control properties window" (let ((app (connection-data-item obj "builder-app-data"))) (if (control-properties-win app) - (window-focus (control-properties-win app)) - (let* ((win (create-gui-window obj :title "Control Properties" - :left 630 - :top 40 - :height 510 :width 400 - :has-pinner t :client-movement t)) - (content (window-content win)) - (control-list (create-table content))) - (setf (control-properties-win app) win) - (setf (properties-list app) control-list) - (set-on-window-close win (lambda (obj) (setf (control-properties-win app) nil))) - (setf (positioning control-list) :absolute) - (set-geometry control-list :units "" :left 0 :top 0 :bottom 0 :width "100%"))))) + (window-focus (control-properties-win app)) + (let* ((win (create-gui-window obj :title "Control Properties" + :left 630 + :top 40 + :height 510 :width 400 + :has-pinner t :client-movement t)) + (content (window-content win)) + (control-list (create-table content))) + (setf (control-properties-win app) win) + (setf (properties-list app) control-list) + (set-on-window-close win (lambda (obj) (setf (control-properties-win app) nil))) + (setf (positioning control-list) :absolute) + (set-geometry control-list :units "" :left 0 :top 0 :bottom 0 :width "100%"))))) (defun on-show-control-events-win (obj) "Show control events window" (let ((app (connection-data-item obj "builder-app-data"))) (if (control-events-win app) - (window-focus (control-events-win app)) - (let* ((win (create-gui-window obj :title "Control Events" - :left 220 - :top 350 - :height 200 :width 400 - :has-pinner t :client-movement t)) - (content (window-content win)) - (control-list (create-table content))) - (setf (control-events-win app) win) - (setf (events-list app) control-list) - (set-on-window-close win (lambda (obj) (setf (control-events-win app) nil))) - (setf (positioning control-list) :absolute) - (set-geometry control-list :units "" :left 0 :top 0 :bottom 0 :width "100%"))))) + (window-focus (control-events-win app)) + (let* ((win (create-gui-window obj :title "Control Events" + :left 220 + :top 350 + :height 200 :width 400 + :has-pinner t :client-movement t)) + (content (window-content win)) + (control-list (create-table content))) + (setf (control-events-win app) win) + (setf (events-list app) control-list) + (set-on-window-close win (lambda (obj) (setf (control-events-win app) nil))) + (setf (positioning control-list) :absolute) + (set-geometry control-list :units "" :left 0 :top 0 :bottom 0 :width "100%"))))) (defun on-show-control-pallete-win (obj) "Show control pallete" (let ((app (connection-data-item obj "builder-app-data"))) (if (control-pallete-win app) - (window-focus (control-pallete-win app)) - (let* ((win (create-gui-window obj :title "Control Pallete" - :top 40 - :left 0 - :height 300 :width 200 - :has-pinner t :client-movement t)) - (content (window-content win)) - (control-list (create-select content))) - (setf (control-pallete-win app) win) - (set-on-window-close win (lambda (obj) (setf (control-pallete-win app) nil))) - (setf (positioning control-list) :absolute) - (setf (size control-list) 2) - (set-geometry control-list :units "" :left 0 :top 0 :bottom 0 :width "100%") - (setf (advisory-title control-list) (format nil " place static~% child to selected")) - (setf (select-tool app) control-list) - (dolist (control *supported-controls*) - (if (equal (getf control :name) "group") - (add-select-optgroup control-list (getf control :description)) - (add-select-option control-list (getf control :name) (getf control :description)))))))) + (window-focus (control-pallete-win app)) + (let* ((win (create-gui-window obj :title "Control Pallete" + :top 40 + :left 0 + :height 300 :width 200 + :has-pinner t :client-movement t)) + (content (window-content win)) + (control-list (create-select content))) + (setf (control-pallete-win app) win) + (set-on-window-close win (lambda (obj) (setf (control-pallete-win app) nil))) + (setf (positioning control-list) :absolute) + (setf (size control-list) 2) + (set-geometry control-list :units "" :left 0 :top 0 :bottom 0 :width "100%") + (setf (advisory-title control-list) (format nil " place static~% child to selected")) + (setf (select-tool app) control-list) + (dolist (control *supported-controls*) + (if (equal (getf control :name) "group") + (add-select-optgroup control-list (getf control :description)) + (add-select-option control-list (getf control :name) (getf control :description)))))))) (defun on-show-control-list-win (obj) "Show control list for selecting and manipulating controls by name" (let ((app (connection-data-item obj "builder-app-data"))) (if (control-list-win app) - (window-focus (control-list-win app)) - (let* ((win (create-gui-window obj :title "Control List" - :top 350 - :left 0 - :width 200 - :has-pinner t :client-movement t))) - (setf (control-list-win app) win) - (setf (advisory-title (window-content win)) - (format nil "Drag and drop order~%Double click non-focusable~%~ + (window-focus (control-list-win app)) + (let* ((win (create-gui-window obj :title "Control List" + :top 350 + :left 0 + :width 200 + :has-pinner t :client-movement t))) + (setf (control-list-win app) win) + (setf (advisory-title (window-content win)) + (format nil "Drag and drop order~%Double click non-focusable~%~ place static~% child to selected")) - (set-on-window-close win (lambda (obj) (setf (control-list-win app) nil))))))) + (set-on-window-close win (lambda (obj) (setf (control-list-win app) nil))))))) (defun on-new-builder-panel (obj) "Open new panel" (let* ((app (connection-data-item obj "builder-app-data")) - (win (create-gui-window obj :top 40 :left 220 - :width 400 :height 300 - :client-movement t)) - (box (create-panel-box-layout (window-content win) - :left-width 0 :right-width 0 - :top-height 30 :bottom-height 0)) - (tool-bar (top-panel box)) - (btn-del (create-button tool-bar :content "Del")) - (btn-copy (create-button tool-bar :content "Copy")) - (btn-paste (create-button tool-bar :content "Paste")) - (btn-sim (create-button tool-bar :content "Sim")) - (btn-test (create-button tool-bar :content "Run")) - (btn-rndr (create-button tool-bar :content "Rndr")) - (btn-save (create-button tool-bar :content "Save")) - (btn-load (create-button tool-bar :content "Load")) - (content (center-panel box)) - (in-simulation nil) - (file-name "") - (render-file-name "") - (panel-id (html-id content))) + (win (create-gui-window obj :top 40 :left 220 + :width 400 :height 300 + :client-movement t)) + (box (create-panel-box-layout (window-content win) + :left-width 0 :right-width 0 + :top-height 30 :bottom-height 0)) + (tool-bar (top-panel box)) + (btn-del (create-button tool-bar :content "Del")) + (btn-copy (create-button tool-bar :content "Copy")) + (btn-paste (create-button tool-bar :content "Paste")) + (btn-sim (create-button tool-bar :content "Sim")) + (btn-test (create-button tool-bar :content "Run")) + (btn-rndr (create-button tool-bar :content "Rndr")) + (btn-save (create-button tool-bar :content "Save")) + (btn-load (create-button tool-bar :content "Load")) + (content (center-panel box)) + (in-simulation nil) + (file-name "") + (render-file-name "") + (panel-id (html-id content))) (setf-next-id content 1) (setf (overflow content) :auto) (init-control-list app panel-id) @@ -991,148 +991,148 @@ of controls and double click to select control." (on-populate-control-list-win content) ;; setup window events (set-on-window-focus win - (lambda (obj) - (declare (ignore obj)) - (on-populate-control-properties-win content :win win) - (on-populate-control-list-win content))) + (lambda (obj) + (declare (ignore obj)) + (on-populate-control-properties-win content :win win) + (on-populate-control-list-win content))) (set-on-window-close win - (lambda (obj) - (declare (ignore obj)) - ;; clear associated windows on close - (setf (current-control app) nil) - (destroy-control-list app panel-id) - (on-populate-control-properties-win content :win win) - (on-populate-control-list-win content))) + (lambda (obj) + (declare (ignore obj)) + ;; clear associated windows on close + (setf (current-control app) nil) + (destroy-control-list app panel-id) + (on-populate-control-properties-win content :win win) + (on-populate-control-list-win content))) (set-on-window-size-done win - (lambda (obj) - (on-populate-control-properties-win content :win win))) + (lambda (obj) + (on-populate-control-properties-win content :win win))) ;; setup tool bar events (set-on-click btn-copy (lambda (obj) - (declare (ignore obj)) - (when (current-control app) - (maphash - (lambda (html-id control) - (declare (ignore html-id)) - (place-inside-bottom-of (bottom-panel box) - (get-placer control))) - (get-control-list app panel-id)) - (setf (copy-buf app) - (js-query content - (format nil - "var z=~a.clone(); z=$('
').append(z);~ + (declare (ignore obj)) + (when (current-control app) + (maphash + (lambda (html-id control) + (declare (ignore html-id)) + (place-inside-bottom-of (bottom-panel box) + (get-placer control))) + (get-control-list app panel-id)) + (setf (copy-buf app) + (js-query content + (format nil + "var z=~a.clone(); z=$('
').append(z);~ z.find('*').each(function(){if($(this).attr('id') !== undefined && ~ $(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~ z.html()" - (clog::jquery (current-control app))))) - (maphash - (lambda (html-id control) - (declare (ignore html-id)) - (place-after control (get-placer control))) - (get-control-list app panel-id))))) + (clog::jquery (current-control app))))) + (maphash + (lambda (html-id control) + (declare (ignore html-id)) + (place-after control (get-placer control))) + (get-control-list app panel-id))))) (set-on-click btn-paste (lambda (obj) - (declare (ignore obj)) - (bordeaux-threads:with-lock-held ((new-control-lock app)) - (when (copy-buf app) - (let ((control (create-control content content - `(:name "custom" - :clog-type clog:clog-element - :create clog:create-child - :create-type :paste) - (format nil "CLOGB~A" (get-universal-time)) - :custom-query (copy-buf app)))) - (setf (attribute control "data-clog-name") - (format nil "~A-~A" "copy" (next-id content))) - (incf-next-id content) - (setup-control content control :win win) - (select-control control) - (add-sub-controls control content :win win :paste t) - (on-populate-control-list-win content)))))) + (declare (ignore obj)) + (bordeaux-threads:with-lock-held ((new-control-lock app)) + (when (copy-buf app) + (let ((control (create-control content content + `(:name "custom" + :clog-type clog:clog-element + :create clog:create-child + :create-type :paste) + (format nil "CLOGB~A" (get-universal-time)) + :custom-query (copy-buf app)))) + (setf (attribute control "data-clog-name") + (format nil "~A-~A" "copy" (next-id content))) + (incf-next-id content) + (setup-control content control :win win) + (select-control control) + (add-sub-controls control content :win win :paste t) + (on-populate-control-list-win content)))))) (set-on-click btn-del (lambda (obj) - (declare (ignore obj)) - (when (current-control app) - (delete-current-control app panel-id (html-id (current-control app))) - (on-populate-control-properties-win content :win win) - (on-populate-control-list-win content)))) + (declare (ignore obj)) + (when (current-control app) + (delete-current-control app panel-id (html-id (current-control app))) + (on-populate-control-properties-win content :win win) + (on-populate-control-list-win content)))) (set-on-click btn-sim (lambda (obj) - (declare (ignore obj)) - (cond (in-simulation - (setf (text btn-sim) "Simulate") - (setf in-simulation nil) - (maphash (lambda (html-id control) - (declare (ignore html-id)) - (setf (hiddenp (get-placer control)) nil)) - (get-control-list app panel-id))) - (t - (setf (text btn-sim) "Develop") - (deselect-current-control app) - (on-populate-control-properties-win content :win win) - (setf in-simulation t) - (maphash (lambda (html-id control) - (declare (ignore html-id)) - (setf (hiddenp (get-placer control)) t)) - (get-control-list app panel-id)) - (focus (first-child content)))))) + (declare (ignore obj)) + (cond (in-simulation + (setf (text btn-sim) "Simulate") + (setf in-simulation nil) + (maphash (lambda (html-id control) + (declare (ignore html-id)) + (setf (hiddenp (get-placer control)) nil)) + (get-control-list app panel-id))) + (t + (setf (text btn-sim) "Develop") + (deselect-current-control app) + (on-populate-control-properties-win content :win win) + (setf in-simulation t) + (maphash (lambda (html-id control) + (declare (ignore html-id)) + (setf (hiddenp (get-placer control)) t)) + (get-control-list app panel-id)) + (focus (first-child content)))))) (set-on-click btn-load (lambda (obj) - (server-file-dialog obj "Load Panel" file-name - (lambda (fname) - (window-focus win) - (when fname - (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 (window-title win) (attribute content "data-clog-name"))))))) + (server-file-dialog obj "Load Panel" file-name + (lambda (fname) + (window-focus win) + (when fname + (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 (window-title win) (attribute content "data-clog-name"))))))) (set-on-click btn-save (lambda (obj) - (server-file-dialog obj "Save Panel As.." file-name - (lambda (fname) - (window-focus win) - (when fname - (setf file-name fname) - (save-panel fname content panel-id (bottom-panel box))) - :initial-filename file-name)))) + (server-file-dialog obj "Save Panel As.." file-name + (lambda (fname) + (window-focus win) + (when fname + (setf file-name fname) + (save-panel fname content panel-id (bottom-panel box))) + :initial-filename file-name)))) (set-on-click btn-test - (lambda (obj) - (do-eval obj (render-clog-code content (bottom-panel box)) - (attribute content "data-clog-name") - :package (attribute content "data-in-package")))) + (lambda (obj) + (do-eval obj (render-clog-code content (bottom-panel box)) + (attribute content "data-clog-name") + :package (attribute content "data-in-package")))) (set-on-click btn-rndr - (lambda (obj) - (server-file-dialog obj "Save As.." file-name - (lambda (fname) - (window-focus win) - (when fname - (setf render-file-name fname) - (write-file (render-clog-code content (bottom-panel box)) - fname))) - :initial-filename render-file-name))) + (lambda (obj) + (server-file-dialog obj "Save As.." file-name + (lambda (fname) + (window-focus win) + (when fname + (setf render-file-name fname) + (write-file (render-clog-code content (bottom-panel box)) + fname))) + :initial-filename render-file-name))) (set-on-mouse-down content - (lambda (obj data) - (declare (ignore obj)) - (unless in-simulation - (when (drop-new-control app content data :win win) - (incf-next-id content))))))) + (lambda (obj data) + (declare (ignore obj)) + (unless in-simulation + (when (drop-new-control app content data :win win) + (incf-next-id content))))))) (defun on-attach-builder-custom (body) "New custom builder page has attached" (let* ((params (form-get-data body)) - (curl (form-data-item params "curl"))) + (curl (form-data-item params "curl"))) (on-attach-builder-page body :custom-boot curl))) (defun on-attach-builder-page (body &key custom-boot) "New builder page has attached" (let* ((params (form-get-data body)) - (panel-uid (form-data-item params "bid")) - (app (gethash panel-uid *app-sync-hash*)) - win - (box (create-panel-box-layout body - :left-width 0 :right-width 0 - :top-height 0 :bottom-height 0)) - (content (center-panel box)) - (in-simulation nil) - (file-name "") - (render-file-name "") - (panel-id (html-id content))) + (panel-uid (form-data-item params "bid")) + (app (gethash panel-uid *app-sync-hash*)) + win + (box (create-panel-box-layout body + :left-width 0 :right-width 0 + :top-height 0 :bottom-height 0)) + (content (center-panel box)) + (in-simulation nil) + (file-name "") + (render-file-name "") + (panel-id (html-id content))) ;; sync new window with app (setf (connection-data-item body "builder-app-data") app) (remhash panel-uid *app-sync-hash*) @@ -1151,182 +1151,182 @@ of controls and double click to select control." (setf (attribute content "data-custom-slots") "") (setf (overflow content) :auto) (set-on-focus (window body) - (lambda (obj) - (declare (ignore obj)) - (setf (title (html-document body)) (attribute content "data-clog-name")))) + (lambda (obj) + (declare (ignore obj)) + (setf (title (html-document body)) (attribute content "data-clog-name")))) ;; setup close of page (set-on-before-unload (window body) - (lambda (obj) - (declare (ignore obj)) - (window-close win))) + (lambda (obj) + (declare (ignore obj)) + (window-close win))) ;; activate associated windows on open (deselect-current-control app) (on-populate-control-properties-win content :win win) (on-populate-control-list-win content) ;; setup window events (set-on-window-focus win - (lambda (obj) - (declare (ignore obj)) - (on-populate-control-properties-win content :win win) - (on-populate-control-list-win content))) + (lambda (obj) + (declare (ignore obj)) + (on-populate-control-properties-win content :win win) + (on-populate-control-list-win content))) (set-on-window-close win - (lambda (obj) - (declare (ignore obj)) - ;; clear associated windows on close - (setf (current-control app) nil) - (destroy-control-list app panel-id) - (close-window (window body)))) + (lambda (obj) + (declare (ignore obj)) + ;; clear associated windows on close + (setf (current-control app) nil) + (destroy-control-list app panel-id) + (close-window (window body)))) ;; setup jquery and jquery-ui (cond (custom-boot - (load-css (html-document body) "/css/jquery-ui.css") - (load-script (html-document body) "/js/jquery-ui.js")) - (t - (clog-gui-initialize body) - (clog-web-initialize body :w3-css-url nil))) + (load-css (html-document body) "/css/jquery-ui.css") + (load-script (html-document body) "/js/jquery-ui.js")) + (t + (clog-gui-initialize body) + (clog-web-initialize body :w3-css-url nil))) ;; init builder (init-control-list app panel-id) (let* ((pbox (create-panel-box-layout (window-content win) - :left-width 0 :right-width 0 - :top-height 30 :bottom-height 0)) - (tool-bar (top-panel pbox)) - (btn-del (create-button tool-bar :content "Del")) - (btn-copy (create-button tool-bar :content "Copy")) - (btn-paste (create-button tool-bar :content "Paste")) - (btn-sim (create-button tool-bar :content "Sim")) - (btn-test (create-button tool-bar :content "Run")) - (btn-rndr (create-button tool-bar :content "Rndr")) - (btn-save (create-button tool-bar :content "Save")) - (btn-load (create-button tool-bar :content "Load")) - (btn-exp (create-button tool-bar :content "Export")) - (wcontent (center-panel pbox))) + :left-width 0 :right-width 0 + :top-height 30 :bottom-height 0)) + (tool-bar (top-panel pbox)) + (btn-del (create-button tool-bar :content "Del")) + (btn-copy (create-button tool-bar :content "Copy")) + (btn-paste (create-button tool-bar :content "Paste")) + (btn-sim (create-button tool-bar :content "Sim")) + (btn-test (create-button tool-bar :content "Run")) + (btn-rndr (create-button tool-bar :content "Rndr")) + (btn-save (create-button tool-bar :content "Save")) + (btn-load (create-button tool-bar :content "Load")) + (btn-exp (create-button tool-bar :content "Export")) + (wcontent (center-panel pbox))) (create-div wcontent :content - "
Drop and work with controls on it's window.
") + "
Drop and work with controls on it's window.
") (setf (background-color tool-bar) :silver) ;; setup tool bar events (set-on-click btn-exp (lambda (obj) - (server-file-dialog obj "Export as Boot HTML" "./" - (lambda (filename) - (when filename - (maphash - (lambda (html-id control) - (declare (ignore html-id)) - (place-inside-bottom-of (bottom-panel box) - (get-placer control))) - (get-control-list app panel-id)) - (save-body-to-file filename :body body :if-exists :rename) - (maphash - (lambda (html-id control) - (declare (ignore html-id)) - (place-after control (get-placer control))) - (get-control-list app panel-id))))))) + (server-file-dialog obj "Export as Boot HTML" "./" + (lambda (filename) + (when filename + (maphash + (lambda (html-id control) + (declare (ignore html-id)) + (place-inside-bottom-of (bottom-panel box) + (get-placer control))) + (get-control-list app panel-id)) + (save-body-to-file filename :body body :if-exists :rename) + (maphash + (lambda (html-id control) + (declare (ignore html-id)) + (place-after control (get-placer control))) + (get-control-list app panel-id))))))) (set-on-click btn-copy (lambda (obj) - (declare (ignore obj)) - (when (current-control app) - (maphash - (lambda (html-id control) - (declare (ignore html-id)) - (place-inside-bottom-of (bottom-panel box) - (get-placer control))) - (get-control-list app panel-id)) - (setf (copy-buf app) - (js-query content - (format nil - "var z=~a.clone(); z=$('
').append(z);~ + (declare (ignore obj)) + (when (current-control app) + (maphash + (lambda (html-id control) + (declare (ignore html-id)) + (place-inside-bottom-of (bottom-panel box) + (get-placer control))) + (get-control-list app panel-id)) + (setf (copy-buf app) + (js-query content + (format nil + "var z=~a.clone(); z=$('
').append(z);~ z.find('*').each(function(){if($(this).attr('id') !== undefined && ~ $(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~ z.html()" - (clog::jquery (current-control app))))) - (maphash - (lambda (html-id control) - (declare (ignore html-id)) - (place-after control (get-placer control))) - (get-control-list app panel-id))))) + (clog::jquery (current-control app))))) + (maphash + (lambda (html-id control) + (declare (ignore html-id)) + (place-after control (get-placer control))) + (get-control-list app panel-id))))) (set-on-click btn-paste (lambda (obj) - (declare (ignore obj)) - (bordeaux-threads:with-lock-held ((new-control-lock app)) - (when (copy-buf app) - (let ((control (create-control content content - `(:name "custom" - :clog-type clog:clog-element - :create clog:create-child - :create-type :paste) - (format nil "CLOGB~A" (get-universal-time)) - :custom-query (copy-buf app)))) - (setf (attribute control "data-clog-name") - (format nil "~A-~A" "copy" (next-id content))) - (incf-next-id content) - (setup-control content control :win win) - (select-control control) - (add-sub-controls control content :win win :paste t) - (on-populate-control-list-win content)))))) + (declare (ignore obj)) + (bordeaux-threads:with-lock-held ((new-control-lock app)) + (when (copy-buf app) + (let ((control (create-control content content + `(:name "custom" + :clog-type clog:clog-element + :create clog:create-child + :create-type :paste) + (format nil "CLOGB~A" (get-universal-time)) + :custom-query (copy-buf app)))) + (setf (attribute control "data-clog-name") + (format nil "~A-~A" "copy" (next-id content))) + (incf-next-id content) + (setup-control content control :win win) + (select-control control) + (add-sub-controls control content :win win :paste t) + (on-populate-control-list-win content)))))) (set-on-click btn-del (lambda (obj) - (declare (ignore obj)) - (when (current-control app) - (delete-current-control app panel-id (html-id (current-control app))) - (on-populate-control-properties-win content :win win) - (on-populate-control-list-win content)))) + (declare (ignore obj)) + (when (current-control app) + (delete-current-control app panel-id (html-id (current-control app))) + (on-populate-control-properties-win content :win win) + (on-populate-control-list-win content)))) (set-on-click btn-sim (lambda (obj) - (declare (ignore obj)) - (cond (in-simulation - (setf (text btn-sim) "Simulate") - (setf in-simulation nil) - (maphash (lambda (html-id control) - (declare (ignore html-id)) - (setf (hiddenp (get-placer control)) nil)) - (get-control-list app panel-id))) - (t - (setf (text btn-sim) "Develop") - (deselect-current-control app) - (on-populate-control-properties-win content :win win) - (setf in-simulation t) - (maphash (lambda (html-id control) - (declare (ignore html-id)) - (setf (hiddenp (get-placer control)) t)) - (get-control-list app panel-id)) - (focus (first-child content)))))) + (declare (ignore obj)) + (cond (in-simulation + (setf (text btn-sim) "Simulate") + (setf in-simulation nil) + (maphash (lambda (html-id control) + (declare (ignore html-id)) + (setf (hiddenp (get-placer control)) nil)) + (get-control-list app panel-id))) + (t + (setf (text btn-sim) "Develop") + (deselect-current-control app) + (on-populate-control-properties-win content :win win) + (setf in-simulation t) + (maphash (lambda (html-id control) + (declare (ignore html-id)) + (setf (hiddenp (get-placer control)) t)) + (get-control-list app panel-id)) + (focus (first-child content)))))) (set-on-click btn-load (lambda (obj) - (declare (ignore obj)) - (server-file-dialog win "Load Panel" file-name - (lambda (fname) - (window-focus win) - (when fname - (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 (title (html-document body)) (attribute content "data-clog-name")) - (setf (window-title win) (attribute content "data-clog-name"))))))) + (declare (ignore obj)) + (server-file-dialog win "Load Panel" file-name + (lambda (fname) + (window-focus win) + (when fname + (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 (title (html-document body)) (attribute content "data-clog-name")) + (setf (window-title win) (attribute content "data-clog-name"))))))) (set-on-click btn-save (lambda (obj) - (server-file-dialog obj "Save Page As.." file-name - (lambda (fname) - (window-focus win) - (when fname - (setf file-name fname) - (save-panel fname content panel-id (bottom-panel box))) - :initial-filename file-name)))) + (server-file-dialog obj "Save Page As.." file-name + (lambda (fname) + (window-focus win) + (when fname + (setf file-name fname) + (save-panel fname content panel-id (bottom-panel box))) + :initial-filename file-name)))) (set-on-click btn-test - (lambda (obj) - (do-eval obj (render-clog-code content (bottom-panel box)) - (attribute content "data-clog-name") - :package (attribute content "data-in-package") - :custom-boot custom-boot))) + (lambda (obj) + (do-eval obj (render-clog-code content (bottom-panel box)) + (attribute content "data-clog-name") + :package (attribute content "data-in-package") + :custom-boot custom-boot))) (set-on-click btn-rndr - (lambda (obj) - (server-file-dialog obj "Save As.." file-name - (lambda (fname) - (window-focus win) - (when fname - (setf render-file-name fname) - (write-file (render-clog-code content (bottom-panel box)) - fname))) - :initial-filename render-file-name)))) + (lambda (obj) + (server-file-dialog obj "Save As.." file-name + (lambda (fname) + (window-focus win) + (when fname + (setf render-file-name fname) + (write-file (render-clog-code content (bottom-panel box)) + fname))) + :initial-filename render-file-name)))) (set-on-mouse-down content - (lambda (obj data) - (declare (ignore obj)) - (unless in-simulation - (when (drop-new-control app content data :win win) - (incf-next-id content))))))) + (lambda (obj data) + (declare (ignore obj)) + (unless in-simulation + (when (drop-new-control app content data :win win) + (incf-next-id content))))))) (defun on-new-builder-basic-page (obj) "Menu item to open new basic HTML page" @@ -1346,75 +1346,75 @@ of controls and double click to select control." "Open custom boot page" (let ((custom-boot "/boot.html")) (input-dialog obj "Boot File Name:" - (lambda (answer) - (when answer - (setf custom-boot answer) - (set-on-new-window 'on-attach-builder-custom - :boot-file custom-boot :path "/builder-custom") - (on-new-builder-page obj :custom-boot custom-boot :url-launch t))) - :default-value custom-boot :modal t))) + (lambda (answer) + (when answer + (setf custom-boot answer) + (set-on-new-window 'on-attach-builder-custom + :boot-file custom-boot :path "/builder-custom") + (on-new-builder-page obj :custom-boot custom-boot :url-launch t))) + :default-value custom-boot :modal t))) (defun on-new-builder-page (obj &key custom-boot url-launch) "Open new page" (let* ((app (connection-data-item obj "builder-app-data")) - (win (create-gui-window obj :top 40 :left 220 :width 400 :client-movement t)) - (panel-uid (format nil "~A" (get-universal-time))) ;; unique id for panel - (boot-loc (if custom-boot - "builder-custom" - "builder-page")) - (curl (if custom-boot - (format nil "&curl=~A" (quri:url-encode custom-boot)) - "")) - (link (format nil "http://127.0.0.1:8080/~A?bid=~A~A" boot-loc panel-uid curl)) - (btn-txt (if url-launch - "Click to launch default browser or copy URL." - "Click if browser does not open new page shortly.")) - (txt-area (create-div (window-content win))) - (page-link (create-a txt-area - :target "_blank" - :content (format nil "
" btn-txt) - :link link)) - (txt-link (create-div txt-area - :content (format nil "
~A
" link))) - content panel-id) + :link link)) + (txt-link (create-div txt-area + :content (format nil "
~A
" link))) + content panel-id) (setf (gethash panel-uid *app-sync-hash*) app) (setf (gethash (format nil "~A-win" panel-uid) *app-sync-hash*) win) (setf (gethash (format nil "~A-link" panel-uid) *app-sync-hash*) - (lambda (obj) - (setf content obj) - (setf panel-id (html-id content)) - (destroy txt-area) - (remhash (format nil "~A-link" panel-uid) *app-sync-hash*))) + (lambda (obj) + (setf content obj) + (setf panel-id (html-id content)) + (destroy txt-area) + (remhash (format nil "~A-link" panel-uid) *app-sync-hash*))) (unless url-launch (open-browser :url link)))) (defun on-help-about-builder (obj) "Open about box" (let ((about (create-gui-window obj - :title "About" - :content "
+ :title "About" + :content "
-
CLOG
-
The Common Lisp Omnificent GUI
-

+
CLOG
+
The Common Lisp Omnificent GUI
+

CLOG Builder
(c) 2022 - David Botton

" - :width 200 - :height 215 - :hidden t))) + :width 200 + :height 215 + :hidden t))) (window-center about) (setf (visiblep about) t) (set-on-window-can-size about (lambda (obj) - (declare (ignore obj))())))) + (declare (ignore obj))())))) (defun on-new-app-template (obj) "Menu option to create new project from template" (let* ((win (create-gui-window obj :title "New Application Template" - :width 500 :height 400)) - (ct (create-clog-templates (window-content win)))) + :width 500 :height 400)) + (ct (create-clog-templates (window-content win)))) (window-center win) (setf (win ct) win) (dolist (tmpl *supported-templates*) @@ -1423,33 +1423,33 @@ of controls and double click to select control." (defun fill-button-clicked (panel) "Template fill botton clicked" (let* ((tmpl-rec (find-if (lambda (x) - (equal (getf x :code) - (value (template-box panel)))) - *supported-templates*)) - (start-dir (format nil "~A~A" - (asdf:system-source-directory :clog) - (getf tmpl-rec :loc))) - (www-dir (format nil "~A~A" - (asdf:system-source-directory :clog) - (getf tmpl-rec :www)))) + (equal (getf x :code) + (value (template-box panel)))) + *supported-templates*)) + (start-dir (format nil "~A~A" + (asdf:system-source-directory :clog) + (getf tmpl-rec :loc))) + (www-dir (format nil "~A~A" + (asdf:system-source-directory :clog) + (getf tmpl-rec :www)))) (setf (hiddenp panel) t) (input-dialog (win panel) "Enter new system name:" (lambda (sys-name) (cond (sys-name - (server-file-dialog - (win panel) "Output Directory" "~/common-lisp/" - (lambda (filename) - (cond (filename - (template-copy sys-name start-dir filename :panel (window-content (win panel))) - (when (getf tmpl-rec :www) - (template-copy sys-name www-dir filename :panel (window-content (win panel)))) - (asdf:clear-source-registry) - (create-div (window-content (win panel)) :content "
done.")) - (t - (window-close (win panel))))))) - (t - (window-close (win panel)))))))) + (server-file-dialog + (win panel) "Output Directory" "~/common-lisp/" + (lambda (filename) + (cond (filename + (template-copy sys-name start-dir filename :panel (window-content (win panel))) + (when (getf tmpl-rec :www) + (template-copy sys-name www-dir filename :panel (window-content (win panel)))) + (asdf:clear-source-registry) + (create-div (window-content (win panel)) :content "
done.")) + (t + (window-close (win panel))))))) + (t + (window-close (win panel)))))))) (defun on-new-builder (body) "Launch instance of the CLOG Builder" @@ -1460,15 +1460,15 @@ of controls and double click to select control." (clog-gui-initialize body) (add-class body "w3-blue-grey") (setf (z-index (create-panel body :positioning :fixed - :bottom 0 :right 0 - :content (format nil "static-root: ~A" clog::*static-root*))) - -9999) + :bottom 0 :right 0 + :content (format nil "static-root: ~A" clog::*static-root*))) + -9999) (let* ((menu (create-gui-menu-bar body)) - (icon (create-gui-menu-icon menu :on-click #'on-help-about-builder)) - (file (create-gui-menu-drop-down menu :content "Builder")) - (tools (create-gui-menu-drop-down menu :content "Tools")) - (win (create-gui-menu-drop-down menu :content "Window")) - (help (create-gui-menu-drop-down menu :content "Help"))) + (icon (create-gui-menu-icon menu :on-click #'on-help-about-builder)) + (file (create-gui-menu-drop-down menu :content "Builder")) + (tools (create-gui-menu-drop-down menu :content "Tools")) + (win (create-gui-menu-drop-down menu :content "Window")) + (help (create-gui-menu-drop-down menu :content "Help"))) (declare (ignore icon)) (create-gui-menu-item file :content "New CLOG-GUI Panel" :on-click 'on-new-builder-panel) (create-gui-menu-item file :content "New CLOG-WEB Page" :on-click 'on-new-builder-page) @@ -1478,9 +1478,9 @@ of controls and double click to select control." (create-gui-menu-item file :content "New Custom Boot Page" :on-click 'on-new-builder-custom) (create-gui-menu-item file :content "New Application Template" :on-click 'on-new-app-template) (create-gui-menu-item file :content "Launch DB Admin" :on-click - (lambda (obj) - (declare (ignore obj)) - (open-window (window body) "/dbadmin"))) + (lambda (obj) + (declare (ignore obj)) + (open-window (window body) "/dbadmin"))) (create-gui-menu-item tools :content "Control Pallete" :on-click 'on-show-control-pallete-win) (create-gui-menu-item tools :content "Control Properties" :on-click 'on-show-control-properties-win) (create-gui-menu-item tools :content "Control Events" :on-click 'on-show-control-events-win) @@ -1489,29 +1489,29 @@ of controls and double click to select control." (create-gui-menu-item win :content "Normalize All" :on-click #'normalize-all-windows) (create-gui-menu-window-select win) (create-gui-menu-item help :content "CLOG Manual" :on-click - (lambda (obj) - (declare (ignore obj)) - (open-window (window body) "https://rabbibotton.github.io/clog/clog-manual.html"))) + (lambda (obj) + (declare (ignore obj)) + (open-window (window body) "https://rabbibotton.github.io/clog/clog-manual.html"))) (create-gui-menu-item help :content "Lisp in Y Minutes" :on-click - (lambda (obj) - (declare (ignore obj)) - (open-window (window body) "https://learnxinyminutes.com/docs/common-lisp/"))) + (lambda (obj) + (declare (ignore obj)) + (open-window (window body) "https://learnxinyminutes.com/docs/common-lisp/"))) (create-gui-menu-item help :content "Simplified Reference" :on-click - (lambda (obj) - (declare (ignore obj)) - (open-window (window body) "https://jtra.cz/stuff/lisp/sclr/index.html"))) + (lambda (obj) + (declare (ignore obj)) + (open-window (window body) "https://jtra.cz/stuff/lisp/sclr/index.html"))) (create-gui-menu-item help :content "Common Lisp Manual" :on-click - (lambda (obj) - (declare (ignore obj)) - (open-window (window body) "http://clhs.lisp.se/"))) + (lambda (obj) + (declare (ignore obj)) + (open-window (window body) "http://clhs.lisp.se/"))) (create-gui-menu-item help :content "W3.CSS Manual" :on-click - (lambda (obj) - (declare (ignore obj)) - (open-window (window body) "https://www.w3schools.com/w3css/"))) + (lambda (obj) + (declare (ignore obj)) + (open-window (window body) "https://www.w3schools.com/w3css/"))) (create-gui-menu-item help :content "Bootstrap 5.1 Manual" :on-click - (lambda (obj) - (declare (ignore obj)) - (open-window (window body) "https://getbootstrap.com/docs/5.1/getting-started/introduction/"))) + (lambda (obj) + (declare (ignore obj)) + (open-window (window body) "https://getbootstrap.com/docs/5.1/getting-started/introduction/"))) (create-gui-menu-item help :content "About CLOG Builder" :on-click #'on-help-about-builder) (create-gui-menu-full-screen menu)) (on-show-control-pallete-win body) @@ -1520,9 +1520,9 @@ of controls and double click to select control." (on-show-control-properties-win body) (on-new-builder-panel body) (set-on-before-unload (window body) (lambda(obj) - (declare (ignore obj)) - ;; return empty string to prevent nav off page - "")))) + (declare (ignore obj)) + ;; return empty string to prevent nav off page + "")))) (defun clog-builder (&key (port 8080) static-root) "Start clog-builder."