mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 10:40:45 -08:00
reorg code
This commit is contained in:
David Botton
parent
1f3ca8d587
commit
f0574c33fb
1 changed files with 170 additions and 167 deletions
|
|
@ -121,6 +121,19 @@
|
||||||
"Increment next id and store it in CONTENT"
|
"Increment next id and store it in CONTENT"
|
||||||
(setf-next-id content (1+ (next-id content))))
|
(setf-next-id content (1+ (next-id content))))
|
||||||
|
|
||||||
|
;; Lisp code evaluation utilities
|
||||||
|
|
||||||
|
(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))
|
||||||
|
(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))))))
|
||||||
|
(format nil "~A~%=>~A~%" result eval-result)))
|
||||||
|
|
||||||
;; Local file utilities
|
;; Local file utilities
|
||||||
|
|
||||||
|
|
@ -139,19 +152,90 @@
|
||||||
(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)))
|
||||||
|
|
||||||
;; Lisp code evaluation utilities
|
(defun save-panel (fname content panel-id hide-loc)
|
||||||
|
"Save panel to FNAME"
|
||||||
|
(let ((app (connection-data-item content "builder-app-data")))
|
||||||
|
(maphash
|
||||||
|
(lambda (html-id control)
|
||||||
|
(declare (ignore html-id))
|
||||||
|
(place-inside-bottom-of hide-loc
|
||||||
|
(get-placer control)))
|
||||||
|
(get-control-list app panel-id))
|
||||||
|
(let ((data
|
||||||
|
(create-child content "<data />"
|
||||||
|
: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"))
|
||||||
|
(setf (attribute data "data-custom-slots")
|
||||||
|
(attribute content "data-custom-slots"))
|
||||||
|
(setf (attribute data "data-clog-next-id")
|
||||||
|
(attribute content "data-clog-next-id"))
|
||||||
|
(setf (attribute data "data-clog-title")
|
||||||
|
(attribute content "data-clog-name"))
|
||||||
|
(write-file (js-query content
|
||||||
|
(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)
|
||||||
|
(destroy data))
|
||||||
|
(maphash
|
||||||
|
(lambda (html-id control)
|
||||||
|
(declare (ignore html-id))
|
||||||
|
(place-after control (get-placer control)))
|
||||||
|
(get-control-list app panel-id))))
|
||||||
|
|
||||||
(defun capture-eval (form &key (eval-in-package "clog-user"))
|
;; Template Utilities
|
||||||
"Capture lisp evaluaton of FORM"
|
|
||||||
(let ((result (make-array '(0) :element-type 'base-char
|
(defun walk-files-and-directories (path process)
|
||||||
:fill-pointer 0 :adjustable t))
|
"Walk PATH and apply PROCESS on each (path and file)"
|
||||||
(eval-result))
|
(let* ((flist (uiop:directory-files path))
|
||||||
(with-output-to-string (stream result)
|
(dlist (uiop:subdirectories path)))
|
||||||
(let* ((*standard-output* stream)
|
(dolist (f flist)
|
||||||
(*error-output* stream)
|
(funcall process path (file-namestring f)))
|
||||||
(*package* (find-package (string-upcase eval-in-package))))
|
(dolist (d dlist)
|
||||||
(setf eval-result (eval (read-from-string (format nil "(progn ~A)" form))))))
|
(walk-files-and-directories d process))))
|
||||||
(format nil "~A~%=>~A~%" result eval-result)))
|
|
||||||
|
(defun template-copy (sys-name start-dir filename &key panel)
|
||||||
|
"Copy START-DIR to FILENAME processing .lt files as cl-template files,
|
||||||
|
if PANEL each copy produces a <b>source</b> to destination added as
|
||||||
|
create-div's"
|
||||||
|
(walk-files-and-directories
|
||||||
|
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)))
|
||||||
|
(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 "<b>~A</b> -> ~A"
|
||||||
|
src-file afile)))))
|
||||||
|
(t
|
||||||
|
(uiop:copy-file src-file out-file)
|
||||||
|
(when panel
|
||||||
|
(create-div panel
|
||||||
|
:content (format nil "<b>~A</b> -> ~A"
|
||||||
|
src-file out-file)))))))))
|
||||||
|
|
||||||
;; Control utilities
|
;; Control utilities
|
||||||
|
|
||||||
|
|
@ -433,6 +517,80 @@ not a temporary attached one when using select-control."
|
||||||
(setf control (next-sibling control))))))
|
(setf control (next-sibling control))))))
|
||||||
(add-siblings (first-child parent)))))
|
(add-siblings (first-child parent)))))
|
||||||
|
|
||||||
|
;; Code rendering utlities
|
||||||
|
|
||||||
|
(defun render-clog-code (content win 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)
|
||||||
|
(unless (or (equal slots "")
|
||||||
|
(equal slots "undefined"))
|
||||||
|
(push slots cmembers))
|
||||||
|
(maphash (lambda (html-id control)
|
||||||
|
(place-inside-bottom-of hide-loc
|
||||||
|
(get-placer 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
|
||||||
|
(format nil "CLOG:~A" (type-of control)))
|
||||||
|
vars)
|
||||||
|
(let ((info (control-info (attribute control "data-clog-type"))))
|
||||||
|
(dolist (event (getf info :events))
|
||||||
|
(let ((handler (attribute control (format nil "data-~A" (getf event :name)))))
|
||||||
|
(unless (or (equalp handler "undefined")
|
||||||
|
(equal handler ""))
|
||||||
|
(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))))))))
|
||||||
|
(get-control-list app panel-id))
|
||||||
|
(let ((result (format nil
|
||||||
|
"\(in-package \"~A\"\)
|
||||||
|
\(defclass ~A \(clog:clog-div\)
|
||||||
|
\(~{~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();~
|
||||||
|
z.find('*').each(function(){for(n in $(this).get(0).dataset){delete $(this).get(0).dataset[n]}});~
|
||||||
|
z.html()"
|
||||||
|
(clog::jquery content)))
|
||||||
|
"\\\"")
|
||||||
|
cname
|
||||||
|
vars
|
||||||
|
events)))
|
||||||
|
(maphash (lambda (html-id control)
|
||||||
|
(declare (ignore html-id))
|
||||||
|
(place-after control (get-placer control)))
|
||||||
|
(get-control-list app panel-id))
|
||||||
|
result)))
|
||||||
|
|
||||||
;; Population of utility windows
|
;; Population of utility windows
|
||||||
|
|
||||||
(defun on-populate-control-events-win (obj)
|
(defun on-populate-control-events-win (obj)
|
||||||
|
|
@ -762,114 +920,6 @@ of controls and double click to select control."
|
||||||
<ctrl> place static~%<shift> child to selected"))
|
<ctrl> place static~%<shift> 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 render-clog-code (content win 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)
|
|
||||||
(unless (or (equal slots "")
|
|
||||||
(equal slots "undefined"))
|
|
||||||
(push slots cmembers))
|
|
||||||
(maphash (lambda (html-id control)
|
|
||||||
(place-inside-bottom-of hide-loc
|
|
||||||
(get-placer 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
|
|
||||||
(format nil "CLOG:~A" (type-of control)))
|
|
||||||
vars)
|
|
||||||
(let ((info (control-info (attribute control "data-clog-type"))))
|
|
||||||
(dolist (event (getf info :events))
|
|
||||||
(let ((handler (attribute control (format nil "data-~A" (getf event :name)))))
|
|
||||||
(unless (or (equalp handler "undefined")
|
|
||||||
(equal handler ""))
|
|
||||||
(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))))))))
|
|
||||||
(get-control-list app panel-id))
|
|
||||||
(let ((result (format nil
|
|
||||||
"\(in-package \"~A\"\)
|
|
||||||
\(defclass ~A \(clog:clog-div\)
|
|
||||||
\(~{~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();~
|
|
||||||
z.find('*').each(function(){for(n in $(this).get(0).dataset){delete $(this).get(0).dataset[n]}});~
|
|
||||||
z.html()"
|
|
||||||
(clog::jquery content)))
|
|
||||||
"\\\"")
|
|
||||||
cname
|
|
||||||
vars
|
|
||||||
events)))
|
|
||||||
(maphash (lambda (html-id control)
|
|
||||||
(declare (ignore html-id))
|
|
||||||
(place-after control (get-placer control)))
|
|
||||||
(get-control-list app panel-id))
|
|
||||||
result)))
|
|
||||||
|
|
||||||
(defun save-panel (fname content panel-id hide-loc)
|
|
||||||
"Save panel to FNAME"
|
|
||||||
(let ((app (connection-data-item content "builder-app-data")))
|
|
||||||
(maphash
|
|
||||||
(lambda (html-id control)
|
|
||||||
(declare (ignore html-id))
|
|
||||||
(place-inside-bottom-of hide-loc
|
|
||||||
(get-placer control)))
|
|
||||||
(get-control-list app panel-id))
|
|
||||||
(let ((data
|
|
||||||
(create-child content "<data />"
|
|
||||||
: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"))
|
|
||||||
(setf (attribute data "data-custom-slots")
|
|
||||||
(attribute content "data-custom-slots"))
|
|
||||||
(setf (attribute data "data-clog-next-id")
|
|
||||||
(attribute content "data-clog-next-id"))
|
|
||||||
(setf (attribute data "data-clog-title")
|
|
||||||
(attribute content "data-clog-name"))
|
|
||||||
(write-file (js-query content
|
|
||||||
(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)
|
|
||||||
(destroy data))
|
|
||||||
(maphash
|
|
||||||
(lambda (html-id control)
|
|
||||||
(declare (ignore html-id))
|
|
||||||
(place-after control (get-placer control)))
|
|
||||||
(get-control-list app panel-id))))
|
|
||||||
|
|
||||||
(defun on-new-builder-panel (obj)
|
(defun on-new-builder-panel (obj)
|
||||||
"Open new panel"
|
"Open new panel"
|
||||||
(let* ((app (connection-data-item obj "builder-app-data"))
|
(let* ((app (connection-data-item obj "builder-app-data"))
|
||||||
|
|
@ -1338,53 +1388,6 @@ of controls and double click to select control."
|
||||||
(dolist (tmpl *supported-templates*)
|
(dolist (tmpl *supported-templates*)
|
||||||
(add-select-option (template-box ct) (getf tmpl :code) (getf tmpl :name)))))
|
(add-select-option (template-box ct) (getf tmpl :code) (getf tmpl :name)))))
|
||||||
|
|
||||||
(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)))
|
|
||||||
(dolist (f flist)
|
|
||||||
(funcall process path (file-namestring f)))
|
|
||||||
(dolist (d dlist)
|
|
||||||
(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,
|
|
||||||
if PANEL each copy produces a <b>source</b> to destination added as
|
|
||||||
create-div's"
|
|
||||||
(walk-files-and-directories
|
|
||||||
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)))
|
|
||||||
(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 "<b>~A</b> -> ~A"
|
|
||||||
src-file afile)))))
|
|
||||||
(t
|
|
||||||
(uiop:copy-file src-file out-file)
|
|
||||||
(when panel
|
|
||||||
(create-div panel
|
|
||||||
:content (format nil "<b>~A</b> -> ~A"
|
|
||||||
src-file out-file)))))))))
|
|
||||||
|
|
||||||
(defun fill-button-clicked (panel)
|
(defun fill-button-clicked (panel)
|
||||||
"Template fill botton clicked"
|
"Template fill botton clicked"
|
||||||
(let* ((tmpl-rec (find-if (lambda (x)
|
(let* ((tmpl-rec (find-if (lambda (x)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue