mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-08 19:50:17 -08:00
Code Issues Projects Releases Wiki Activity

name controls and delete controls

Browse source
This commit is contained in:
David Botton 2021-12-14 16:35:41 -05:00
parent c2e4436230
commit 17d72d8a23
1 changed files with 31 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

51
tools/clog-builder.lisp
View file

@ -76,13 +76,13 @@
(defun read-file (infile) (defun read-file (infile)
(with-open-file (instream infile :direction :input :if-does-not-exist nil) (with-open-file (instream infile :direction :input :if-does-not-exist nil)
(when instream (when instream
(let ((string (make-string (file-length instream)))) (let ((string (make-string (file-length instream))))
(read-sequence string instream) (read-sequence string instream)
string)))) string))))
(defun write-file (string outfile &key (action-if-exists :rename)) (defun write-file (string outfile &key (action-if-exists :rename))
(check-type action-if-exists (member nil :error :new-version :rename :rename-and-delete (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) (with-open-file (outstream outfile :direction :output :if-exists action-if-exists)
(write-sequence string outstream))) (write-sequence string outstream)))
@ -95,7 +95,7 @@
(let ((*standard-output* stream) (let ((*standard-output* stream)
(*error-output* stream)) (*error-output* stream))
(setf eval-result (eval (read-from-string (format nil "(progn ~A)" form)))))) (setf eval-result (eval (read-from-string (format nil "(progn ~A)" form))))))
(format nil "~A~%=>~A~%" result eval-result))) (format nil "~A~%=>~A~%" result eval-result)))
(defun do-ide-edit-copy (obj) (defun do-ide-edit-copy (obj)
(let ((cw (current-window obj))) (let ((cw (current-window obj)))
@ -113,7 +113,7 @@
(do-ide-edit-copy obj) (do-ide-edit-copy obj)
(js-execute obj (format nil "editor_~A.execCommand('undo')" (js-execute obj (format nil "editor_~A.execCommand('undo')"
(html-id cw)))))) (html-id cw))))))
(defun do-ide-edit-redo (obj) (defun do-ide-edit-redo (obj)
(let ((cw (current-window obj))) (let ((cw (current-window obj)))
(when cw (when cw
@ -236,13 +236,16 @@
(control (current-control app)) (control (current-control app))
(table (properties-list app)) (table (properties-list app))
(parent (when control (parent-element control)))) (parent (when control (parent-element control))))
(when (and win control) (when (and win control)
(setf (inner-html table) "") (setf (inner-html table) "")
(let ((props `(("Name" ,(html-id control) nil) (let ((props `(("ID" ,(html-id control) nil)
("Name" ,(attribute control "data-lisp-name") t
,(lambda (obj)
(setf (attribute control "data-lisp-name") (text obj))))
("Top" ,(top parent) t ,(lambda (obj) ("Top" ,(top parent) t ,(lambda (obj)
(setf (top parent) (text obj)))) (setf (top parent) (text obj))))
("Left" ,(left parent) t ,(lambda (obj) ("Left" ,(left parent) t ,(lambda (obj)
(setf (left parent) (text obj)))) (setf (left parent) (text obj))))
("Width" ,(width parent) t ,(lambda (obj) ("Width" ,(width parent) t ,(lambda (obj)
(setf (width parent) (text obj)))) (setf (width parent) (text obj))))
("Height" ,(height parent) t ,(lambda (obj) ("Height" ,(height parent) t ,(lambda (obj)
@ -252,7 +255,7 @@
(setf (value control) (text obj)))) (setf (value control) (text obj))))
`("Text" ,(text control) t ,(lambda (obj) `("Text" ,(text control) t ,(lambda (obj)
(setf (text control) (text obj)))))))) (setf (text control) (text obj))))))))
(dolist (item props) (dolist (item props)
(let* ((tr (create-table-row table)) (let* ((tr (create-table-row table))
(td1 (create-table-column tr :content (first item))) (td1 (create-table-column tr :content (first item)))
(td2 (create-table-column tr :content (second item)))) (td2 (create-table-column tr :content (second item))))
@ -264,7 +267,7 @@
(defun on-show-properties (obj) (defun on-show-properties (obj)
(let ((app (connection-data-item obj "builder-app-data"))) (let ((app (connection-data-item obj "builder-app-data")))
(if (control-properties app) (if (control-properties app)
(window-focus (control-properties app)) (window-focus (control-properties app))
(let* ((win (create-gui-window obj :title "Properties" (let* ((win (create-gui-window obj :title "Properties"
:height 300 :width 200 :height 300 :width 200
:has-pinner t)) :has-pinner t))
@ -289,10 +292,10 @@
(setf (positioning control-list) :absolute) (setf (positioning control-list) :absolute)
(setf (size control-list) 2) (setf (size control-list) 2)
(set-geometry control-list :left 0 :top 0 :bottom 0 :width 190) (set-geometry control-list :left 0 :top 0 :bottom 0 :width 190)
(set-on-change control-list (lambda (obj) (set-on-change control-list (lambda (obj)
(setf (selected-tool app) (control-info (value control-list))))) (setf (selected-tool app) (control-info (value control-list)))))
(set-on-focus control-list (lambda (obj) (set-on-focus control-list (lambda (obj)
(setf (selected-tool app) (control-info (value control-list))))) (setf (selected-tool app) (control-info (value control-list)))))
(dolist (control supported-controls) (dolist (control supported-controls)
(add-select-option control-list (getf control :name) (getf control :description))))))) (add-select-option control-list (getf control :name) (getf control :description)))))))
@ -303,11 +306,17 @@
:left-width 0 :right-width 9 :left-width 0 :right-width 9
:top-height 30 :bottom-height 0)) :top-height 30 :bottom-height 0))
(tool-bar (top-panel box)) (tool-bar (top-panel box))
(btn-del (create-button tool-bar :content "Delete"))
(btn-save (create-button tool-bar :content "Render")) (btn-save (create-button tool-bar :content "Render"))
(content (center-panel box))) (content (center-panel box)))
(setf (background-color tool-bar) :silver) (setf (background-color tool-bar) :silver)
(setf (attribute content "data-lisp-name")
(format nil "form-~A" (html-id content)))
(set-on-click btn-del (lambda (obj)
(when (current-control app)
(destroy (parent-element (current-control app)))
(setf (current-control app) nil))))
(set-on-click btn-save (lambda (obj) (set-on-click btn-save (lambda (obj)
(declare (ignore obj))
(let* ((cw (on-show-layout-code obj)) (let* ((cw (on-show-layout-code obj))
(result (format nil (result (format nil
"(defvar *form_~A* \"~A\")~%~ "(defvar *form_~A* \"~A\")~%~
@ -337,16 +346,18 @@
(element (cond ((eq create-type :label) (element (cond ((eq create-type :label)
(funcall (getf control :create) handle (funcall (getf control :create) handle
:content (getf control :create-content))) :content (getf control :create-content)))
((eq create-type :form) ((eq create-type :form)
(funcall (getf control :create) handle (funcall (getf control :create) handle
(getf control :create-param) (getf control :create-param)
:value (getf control :create-value))) :value (getf control :create-value)))
(t nil)))) (t nil))))
(when element (when element
(setf (current-control app) element) (setf (current-control app) element)
(setf (attribute element "data-lisp-name")
(format nil "control-~A" (html-id element)))
(setf (box-sizing element) :content-box) (setf (box-sizing element) :content-box)
(setf (box-sizing handle) :content-box) (setf (box-sizing handle) :content-box)
(set-padding handle "0px" "16px" "0px" "0px") (set-padding handle "0px" "16px" "0px" "0px")
(set-on-mouse-up element (lambda (obj data) (set-on-mouse-up element (lambda (obj data)
(setf (current-control app) element) (setf (current-control app) element)
(on-populate-control-properties win))) (on-populate-control-properties win)))
@ -389,13 +400,13 @@
(declare (ignore obj))())))) (declare (ignore obj))()))))
(defun on-new-builder (body) (defun on-new-builder (body)
(set-html-on-close body "Connection Lost") (set-html-on-close body "Connection Lost")
(let ((app (make-instance 'builder-app-data))) (let ((app (make-instance 'builder-app-data)))
(setf (connection-data-item body "builder-app-data") app) (setf (connection-data-item body "builder-app-data") app)
(setf (title (html-document body)) "CLOG Builder") (setf (title (html-document body)) "CLOG Builder")
(clog-gui-initialize body) (clog-gui-initialize body)
(load-script (html-document body) "https://pagecdn.io/lib/ace/1.4.12/ace.js") (load-script (html-document body) "https://pagecdn.io/lib/ace/1.4.12/ace.js")
(add-class body "w3-blue-grey") (add-class body "w3-blue-grey")
(let* ((menu (create-gui-menu-bar body)) (let* ((menu (create-gui-menu-bar body))
(icon (create-gui-menu-icon menu :on-click #'on-help-about-builder)) (icon (create-gui-menu-icon menu :on-click #'on-help-about-builder))
(file (create-gui-menu-drop-down menu :content "Builder")) (file (create-gui-menu-drop-down menu :content "Builder"))
@ -422,7 +433,7 @@
(set-on-before-unload (window body) (lambda(obj) (set-on-before-unload (window body) (lambda(obj)
(declare (ignore obj)) (declare (ignore obj))
;; return empty string to prevent nav off page ;; return empty string to prevent nav off page
"")) ""))
(run body))) (run body)))
(defun clog-builder () (defun clog-builder ()