mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

properly use ace editor for events

Browse source
This commit is contained in:
David Botton 2022-07-12 19:38:31 -04:00
parent 02e4ed8fc1
commit ea92bb20c3
3 changed files with 110 additions and 101 deletions
Download patch file Download diff file Expand all files Collapse all files

3
README.md
View file

@ -70,10 +70,11 @@ most up to date version or you can also clone the github repo into
(push #P"path/to/dir/of/projects" ql:*local-project-directories*) ]: (push #P"path/to/dir/of/projects" ql:*local-project-directories*) ]:
``` ```
For git: For git (you need the ace editor plug in for the builder too from git):
cd ~/common-lisp cd ~/common-lisp
git clone https://github.com/rabbibotton/clog.git git clone https://github.com/rabbibotton/clog.git
git clone https://github.com/rabbibotton/clog-ace.git
To add UltraLisp to QuickLisp (_RECOMMENDED_): To add UltraLisp to QuickLisp (_RECOMMENDED_):

2
clog.asd
View file

@ -48,7 +48,7 @@
:components ((:file "clog-docs"))) :components ((:file "clog-docs")))
(asdf:defsystem #:clog/tools (asdf:defsystem #:clog/tools
:depends-on (#:clog #:s-base64) :depends-on (#:clog #:clog-ace #:s-base64)
:pathname "tools/" :pathname "tools/"
:components ((:file "clog-db-admin") :components ((:file "clog-db-admin")
(:file "clog-builder-settings") (:file "clog-builder-settings")

206
tools/clog-builder.lisp
View file

@ -41,7 +41,11 @@
(events-list (events-list
:accessor events-list :accessor events-list
:initform nil :initform nil
:documentation "Property list in events window") :documentation "Event list in events window")
(event-editor
:accessor event-editor
:initform nil
:documentation "Editor in events window")
(control-events-win (control-events-win
:accessor control-events-win :accessor control-events-win
:initform nil :initform nil
@ -542,8 +546,8 @@ replaced."
;; Control selection utilities ;; Control selection utilities
(defun get-placer (control) (defun get-placer (control)
"Get placer for CONTROL. A placer is a div placed on top of the control and "Get placer for CONTROL. A placer is a div placed on top of CONTROL and
prevents access to use or activate the control directylu and allows prevents access to use or activate the control directy and allows
manipulation of the control's location and size." manipulation of the control's location and size."
(when control (when control
(attach-as-child control (format nil "p-~A" (html-id control))))) (attach-as-child control (format nil "p-~A" (html-id control)))))
@ -759,56 +763,50 @@ not a temporary attached one when using select-control."
;; obj if current-control is nil must be content ;; obj if current-control is nil must be content
(let* ((app (connection-data-item obj "builder-app-data")) (let* ((app (connection-data-item obj "builder-app-data"))
(event-win (control-events-win app)) (event-win (control-events-win app))
(elist (events-list app))
(control (if (current-control app) (control (if (current-control app)
(current-control app) (current-control app)
obj)) obj)))
(table (events-list app)))
(when event-win (when event-win
(setf (inner-html table) "") (setf (inner-html elist) "")
(let ((info (control-info (attribute control "data-clog-type"))) (remove-attribute elist "data-current-event")
events) (set-on-blur (event-editor app) nil)
(dolist (event (reverse (getf info :events))) (set-on-change elist nil)
(let ((attr (format nil "data-~A" (getf event :name)))) (let ((info (control-info (attribute control "data-clog-type"))))
(push `(,(getf event :name) (add-select-option elist "" "Select Event")
,(let ((txt (attribute control attr))) (setf (text-value (event-editor app)) "")
(if (equalp txt "undefined") (labels ((on-blur (obj)
"" (let ((attr (attribute elist "data-current-event")))
txt)) (unless (equalp attr "undefined")
,(getf event :parameters) (let ((txt (text-value (event-editor app))))
,(getf event :setup) (cond ((or (equal txt "")
,(lambda (obj) (equalp txt "undefined"))
(let ((txt (text-value obj))) (remove-attribute control attr))
(if (or (equal txt "") (t
(equalp txt "undefined")) (setf (attribute control attr) (text-value (event-editor app))))))
(remove-attribute control attr) (jquery-execute (get-placer control) "trigger('clog-builder-snap-shot')")))))
(setf (attribute control attr) (text-value obj)))))) (set-on-change elist (lambda (obj)
events))) (declare (ignore obj))
(dolist (item events) (let ((event (select-value elist "clog-events")))
(let* ((tr (create-table-row table)) (cond ((equal event "")
(td1 (create-table-column tr :content (first item))) (set-on-blur (event-editor app) nil)
(td2 (create-table-column tr)) (setf (text-value (event-editor app)) ""))
(editor nil)) (t
(setf (width td1) "30%") (let* ((attr (format nil "data-~A" event))
(setf (width td2) "70%") (txt (attribute control attr)))
(set-border td1 "1px" :dotted :black) (setf (text-value (event-editor app))
(setf (advisory-title td1) (format nil "params: panel ~A" (third item))) (if (equalp txt "undefined")
(cond ((fourth item) ""
(setf editor td2) txt))
(setf (editablep td2) (funcall (fourth item) control td1 td2))) (setf (attribute elist "data-current-event") attr)
(t (focus (event-editor app))
;; (setf editor (clog-ace:create-clog-ace-element td2)) (set-on-blur (event-editor app) #'on-blur))))))))
;; (setf (clog-ace:theme editor) "ace/theme/xcode") (dolist (event (getf info :events))
;; (setf (clog-ace:mode editor) "ace/mode/lisp") (add-select-option elist
;; (setf (clog-ace:tab-size editor) 2) (getf event :name)
(setf editor (create-text-area td2)) (format nil "~A (panel ~A)"
(setf (spellcheckp editor) nil) (getf event :name)
(setf (width editor) "95%"))) ; leave space for scroll bar (getf event :parameters))))))))
(setf (text-value editor) (second item))
(set-on-blur editor
(lambda (obj)
(declare (ignore obj))
(funcall (fifth item) obj)
(jquery-execute (get-placer control) "trigger('clog-builder-snap-shot')")))))))))
(defun on-populate-control-properties-win (obj &key win) (defun on-populate-control-properties-win (obj &key win)
"Populate the control properties for the current control" "Populate the control properties for the current control"
@ -874,8 +872,8 @@ not a temporary attached one when using select-control."
,(lambda (obj) ,(lambda (obj)
(setf (attribute control "data-clog-name") (text obj)) (setf (attribute control "data-clog-name") (text obj))
(when (equal (getf info :name) "clog-data") (when (equal (getf info :name) "clog-data")
(when win (when win
(setf (window-title win) (text obj)))))) (setf (window-title win) (text obj))))))
props) props)
(dolist (item props) (dolist (item props)
(let* ((tr (create-table-row table)) (let* ((tr (create-table-row table))
@ -896,7 +894,7 @@ not a temporary attached one when using select-control."
(lambda (obj) (lambda (obj)
(funcall (fourth item) obj) (funcall (fourth item) obj)
(when placer (when placer
(jquery-execute placer "trigger('clog-builder-snap-shot')") (jquery-execute placer "trigger('clog-builder-snap-shot')")
(set-geometry placer :top (position-top control) (set-geometry placer :top (position-top control)
:left (position-left control) :left (position-left control)
:width (client-width control) :width (client-width control)
@ -914,19 +912,19 @@ of controls and double click to select control."
(let ((app (connection-data-item content "builder-app-data"))) (let ((app (connection-data-item content "builder-app-data")))
(let ((panel-id (html-id content)) (let ((panel-id (html-id content))
(last-ctl nil)) (last-ctl nil))
(when (control-list-win app) (when (control-list-win app)
(let ((lwin (control-list-win app))) (let ((lwin (control-list-win app)))
(setf (inner-html lwin) "") (setf (inner-html lwin) "")
(set-on-mouse-click (create-div lwin :content (attribute content "data-clog-name")) (set-on-mouse-click (create-div lwin :content (attribute content "data-clog-name"))
(lambda (obj data) (lambda (obj data)
(deselect-current-control app) (deselect-current-control app)
(on-populate-control-properties-win content :win win) (on-populate-control-properties-win content :win win)
(on-populate-control-list-win content :win win))) (on-populate-control-list-win content :win win)))
(labels ((add-siblings (control sim) (labels ((add-siblings (control sim)
(let (dln dcc) (let (dln dcc)
(loop (loop
(when (equal (html-id control) "undefined") (return)) (when (equal (html-id control) "undefined") (return))
(setf dcc (attribute control "data-clog-composite-control")) (setf dcc (attribute control "data-clog-composite-control"))
(setf dln (attribute control "data-clog-name")) (setf dln (attribute control "data-clog-name"))
(unless (equal dln "undefined") (unless (equal dln "undefined")
(let ((list-item (create-div lwin :content (format nil "↕ ~A~A" sim dln))) (let ((list-item (create-div lwin :content (format nil "↕ ~A~A" sim dln)))
@ -944,8 +942,8 @@ of controls and double click to select control."
panel-id panel-id
html-id))) html-id)))
(cond ((or (getf data :shift-key) (cond ((or (getf data :shift-key)
(getf data :ctrl-key) (getf data :ctrl-key)
(getf data :meta-key)) (getf data :meta-key))
(when (drop-new-control app content data) (when (drop-new-control app content data)
(incf-next-id content))) (incf-next-id content)))
(t (t
@ -962,9 +960,9 @@ of controls and double click to select control."
html-id)) html-id))
(placer (get-placer control)) (placer (get-placer control))
(state (hiddenp placer))) (state (hiddenp placer)))
(setf (hiddenp placer) (not state)) (setf (hiddenp placer) (not state))
(select-control control) (select-control control)
(on-populate-control-list-win content :win win)))) (on-populate-control-list-win content :win win))))
;; drag and drop to change ;; drag and drop to change
(set-on-drag-over list-item (lambda (obj)(declare (ignore obj))())) (set-on-drag-over list-item (lambda (obj)(declare (ignore obj))()))
(set-on-drop list-item (set-on-drop list-item
@ -978,24 +976,24 @@ of controls and double click to select control."
(getf data :drag-data))) (getf data :drag-data)))
(placer1 (get-placer control1)) (placer1 (get-placer control1))
(placer2 (get-placer control2))) (placer2 (get-placer control2)))
(if (getf data :shift-key) (if (getf data :shift-key)
(place-inside-bottom-of control1 control2) (place-inside-bottom-of control1 control2)
(place-before control1 control2)) (place-before control1 control2))
(place-after control2 placer2) (place-after control2 placer2)
(set-geometry placer1 :top (position-top control1) (set-geometry placer1 :top (position-top control1)
:left (position-left control1) :left (position-left control1)
:width (client-width control1) :width (client-width control1)
:height (client-height control1)) :height (client-height control1))
(set-geometry placer2 :top (position-top control2) (set-geometry placer2 :top (position-top control2)
:left (position-left control2) :left (position-left control2)
:width (client-width control2) :width (client-width control2)
:height (client-height control2)) :height (client-height control2))
(on-populate-control-properties-win content :win win) (on-populate-control-properties-win content :win win)
(on-populate-control-list-win content :win win)))) (on-populate-control-list-win content :win win))))
(set-on-drag-start list-item (lambda (obj)(declare (ignore obj))()) (set-on-drag-start list-item (lambda (obj)(declare (ignore obj))())
:drag-data (html-id control)) :drag-data (html-id control))
(when (equal dcc "undefined") ; when t is not a composite control (when (equal dcc "undefined") ; when t is not a composite control
(add-siblings (first-child control) (format nil "~A→" sim))))) (add-siblings (first-child control) (format nil "~A→" sim)))))
(setf control (next-sibling control)))))) (setf control (next-sibling control))))))
(add-siblings (first-child content) "")))))))) (add-siblings (first-child content) ""))))))))
@ -1024,13 +1022,13 @@ of controls and double click to select control."
(defun on-show-control-properties-win (obj) (defun on-show-control-properties-win (obj)
"Show control properties window" "Show control properties window"
(let* ((app (connection-data-item obj "builder-app-data")) (let* ((app (connection-data-item obj "builder-app-data"))
(is-hidden nil) (is-hidden nil)
(panel (create-panel (connection-body obj) :positioning :fixed (panel (create-panel (connection-body obj) :positioning :fixed
:width 400 :width 400
:top 40 :top 40
:right 0 :bottom 0 :right 0 :bottom 0
:class "w3-border-left")) :class "w3-border-left"))
(content (create-panel panel :width 390 :top 0 :right 0 :bottom 0)) (content (create-panel panel :width 390 :top 0 :right 0 :bottom 0))
(side-panel (create-panel panel :top 0 :left 0 :bottom 0 :width 10)) (side-panel (create-panel panel :top 0 :left 0 :bottom 0 :width 10))
(control-list (create-table content))) (control-list (create-table content)))
(setf (background-color side-panel) :black) (setf (background-color side-panel) :black)
@ -1038,12 +1036,12 @@ of controls and double click to select control."
(setf (control-properties-win app) content) (setf (control-properties-win app) content)
(setf (properties-list app) control-list) (setf (properties-list app) control-list)
(set-on-click side-panel (lambda (obj) (set-on-click side-panel (lambda (obj)
(cond (is-hidden (cond (is-hidden
(setf (width panel) "400px") (setf (width panel) "400px")
(setf is-hidden nil)) (setf is-hidden nil))
(t (t
(setf (width panel) "10px") (setf (width panel) "10px")
(setf is-hidden t))))) (setf is-hidden t)))))
(setf (overflow content) :auto) (setf (overflow content) :auto)
(setf (positioning control-list) :absolute) (setf (positioning control-list) :absolute)
(set-geometry control-list :left 0 :top 0 :right 0))) (set-geometry control-list :left 0 :top 0 :right 0)))
@ -1053,20 +1051,30 @@ of controls and double click to select control."
(let ((app (connection-data-item obj "builder-app-data"))) (let ((app (connection-data-item obj "builder-app-data")))
(if (control-events-win app) (if (control-events-win app)
(window-focus (control-events-win app)) (window-focus (control-events-win app))
(let* ((win (create-gui-window obj :title "Control Events" (let* ((win (create-gui-window obj :title "Control Events"
:left 225 :left 225
:top 480 :top 480
:height 200 :width 600 :height 200 :width 645
:has-pinner t :client-movement t)) :has-pinner t :client-movement t))
(content (window-content win)) (content (window-content win)))
(control-list (create-table content)))
(setf (control-events-win app) win) (setf (control-events-win app) win)
(setf (events-list app) control-list) (setf (events-list app) (create-select content :name "clog-events"))
(setf (positioning (events-list app)) :absolute)
(set-geometry (events-list app) :top 5 :left 5 :right 5)
(setf (event-editor app) (clog-ace:create-clog-ace-element content))
(setf (positioning (event-editor app)) :absolute)
(setf (width (event-editor app)) "")
(setf (height (event-editor app)) "")
(set-geometry (event-editor app) :top 35 :left 5 :right 5 :bottom 5)
(clog-ace:resize (event-editor app))
(setf (clog-ace:theme (event-editor app)) "ace/theme/xcode")
(setf (clog-ace:mode (event-editor app)) "ace/mode/lisp")
(setf (clog-ace:tab-size (event-editor app)) 2)
(set-on-window-close win (lambda (obj) (set-on-window-close win (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(setf (control-events-win app) nil))) (setf (event-editor app) nil)
(setf (positioning control-list) :absolute) (setf (events-list app) nil)
(set-geometry control-list :units "" :left 0 :top 0 :bottom 0 :width "100%"))))) (setf (control-events-win app) nil)))))))
(defun on-show-copy-history-win (obj) (defun on-show-copy-history-win (obj)
"Create and show copy/but history" "Create and show copy/but history"
@ -1163,7 +1171,7 @@ of controls and double click to select control."
"Open new panel" "Open new panel"
(let* ((app (connection-data-item obj "builder-app-data")) (let* ((app (connection-data-item obj "builder-app-data"))
(win (create-gui-window obj :top 40 :left 225 (win (create-gui-window obj :top 40 :left 225
:width 600 :height 430 :width 645 :height 430
:client-movement t)) :client-movement t))
(box (create-panel-box-layout (window-content win) (box (create-panel-box-layout (window-content win)
:left-width 0 :right-width 0 :left-width 0 :right-width 0