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

docs and output improvements

Browse source
This commit is contained in:
David Botton 2022-02-06 13:02:08 -05:00
parent aec8a4b16e
commit 83b23a818a
1 changed files with 12 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

18
tools/clog-builder.lisp
View file

@ -1334,13 +1334,15 @@ of controls and double click to select control."
(defun on-new-app-template (obj)
(let* ((app (connection-data-item obj "builder-app-data"))
(win (create-gui-window obj :title "New Application Template"))
(win (create-gui-window obj :title "New Application Template"
:width 500 :height 400))
(ct (create-clog-templates (window-content win))))
(setf (win ct) win)
(dolist (tmpl *supported-templates*)
(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)
@ -1349,6 +1351,9 @@ of controls and double click to select control."
(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)
@ -1373,13 +1378,13 @@ of controls and double click to select control."
(list :sys-name sys-name))
afile)
(when panel
(create-div (window-content (win 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 (window-content (win panel))
(create-div panel
:content (format nil "<b>~A</b> -> ~A"
src-file out-file)))))))))
@ -1403,10 +1408,11 @@ of controls and double click to select control."
(win panel) "Output Directory" "~/common-lisp/"
(lambda (filename)
(cond (filename
(template-copy sys-name start-dir filename :panel panel)
(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 panel))
(asdf:clear-source-registry))
(template-copy sys-name www-dir filename :panel (window-content (win panel))))
(asdf:clear-source-registry)
(create-div (window-content (win panel)) :content "<hr><b>done.</b>"))
(t
(window-close (win panel)))))))
(t